REPAIRING COMPACTING DATABASE WITH VBA

Introduction.

Repairing and Compacting the Database is an essential function to keep its Size on Disk to the minimum. When you work with the Database MS-Access creates temporary work objects within the Database resulting in the file size keeps expanding.

If the Database is a Single User one, then there isn't much to worry about this issue, because all you have to do is to enable the Compacting on Close feature in the Access Options settings.

Select the Menu Tools - -> Options - - > General Tab and put a checkmark in the Compact on Close option. Every time MS-Access will compact the Database when you close it.

But, if the Database is Shared on Network then enabling this feature can lead to problems. You should have Exclusive Access to the Database to run compacting. When you turn on the Compact on Close feature, it will attempt to run the Compact and Repair procedure but will fail if others are using it. We don't know what will be the impact of these repeated attempts and failures, from different sharing points, on the Database. Enabling the Exclusive Access Option (Tools - -> Security - -> User and Group Permissions - -> Permissions Tab) will not allow concurrent sharing.

Why MS-Access insists on Exclusive Access to the Database for compacting is because it deletes the original Database in this process and re-creates it. Check the following steps taken by the compacting Procedure:

Database Compacting Steps.

1. Select Tools - -> Database Utilities - - > Compact and Repair Database. Closes the Current Database.
2. Creates a temporary Database with the name db1.mdb in the current folder.
3. Transfers all the Objects (Tables, Forms, Reports, etc.), except the work objects, into db1.mdb.
4. Deletes the original Database.
5. Renames db1.mdb file to the original name.
6. Opens the newly created Database.

When No Database is active.

If a database is not active when you select the option in Step-1 you are asked to select the Source Database from the disk and will prompt for a Target Name to save the compacted copy in your preferred location. It will not re-create it with the original name. It is up to you to decide what to do with the old and new Database Files.

To do compacting on the Server, User-level Disk Quota Allocation is also a matter of concern. The User should have double the size of the Database or more free disk space available under his allocated Disk Quota.

In these circumstances, a separate Compacting Utility Program is useful when you have several Databases shared with the Network. We are going to create such a Database with VBA Programs that can compact one or more Databases easily. The Program follows the same route map described in Step-1 to 7 above, and with some changes in the way the procedure is Run.

The Compacting Utility, that we are going to create, has the following advantages:

• Uses Local Disk Space for Work-File, which will speed up the process, and extra space on the server is not required for this purpose.
• Can select more than one Database for compacting.
• Takes a safe Backup on Local Drive besides compacting.
• No failures due to the non-availability of enough Disk Space under the User's Disk Quota.

We will create a small Database with a Table to hold a list of Database Path Names, a Form, and two VBA Programs on the Form Module.

The Design Task

1. Create a new Database with the name CompUtil.mdb.

2. Create a Table with the following structure.

   Table: FilesList

   Field Name	Type	Size
   ID	AutoNumber
   dbPath	Text	75

3. Save the Table with the name FilesList and key in the full path names of your Databases running on the Server and close the table. Do not use UNC ("\\ServerName\FolderName\DatabaseNname") type addressing method.

   

4. Open a new Form and create a List Box using the FilesList Table. See the design given below. Draw two Label Controls below the List Box and two Command Buttons below that, side by side.

   

5. Resize the Controls and position them, to look almost like the design given above. The finished design in Normal View is given below. The Labels below the List Box are kept hidden and will appear only when we run the Program.

   

   Change the Property Values of the Form and Controls so that you can make them look exactly like the design given above.

6. Click on the List Box and display the property sheet (View - - > Properties).

7. Change the List Box's Property Values as given below:

   • Name: dbList
   • Row Source Type: Table/Query
   • Row Source: SELECT [FilesList].[ID], [FilesList].[dbPath] FROM [FilesList]
   • Column Count: 2
   • Column Heads: No
   • Column Widths: 0.2396";1.4271"
   • Bound Column: 2
   • Enabled: Yes
   • Locked: No
   • Multiselect: Simple
   • Tab Index: 0
   • Left: 0.3021"
   • Top: 0.7083"
   • Width: 3.2083"
   • Height: 1.7708"
   • Back Color: 16777215
   • Special Effect: Sunken

8. Resize the child Label Control, attached to the List Box, to the same size and position it above the List Box. Change the Caption to Database List.

9. Click on the first Label Control below the List Box, display the Property Sheet, and change the following Properties:

   • Name: lblMsg
   • Visible: No
   • Left: 0.3021"
   • Top: 2.5"
   • Width: 3.2083"
   • Height: 0.5"
   • Back Color: 128
   • Special Effect: Sunken

10. Display the Property Sheet of the second Label Control and change the following Properties:

    • Name: lblstat
    • Visible: No
    • Left: 0.3021"
    • Top: 3.0417"
    • Width: 3.2083"
    • Height: 0.1667"
    • Back Style: Transparent
    • Back Color: 16777215
    • Special Effect: Flat
    • Border Style: Transparent

11. Change the following properties of the left-side Command Button:

    • Name: cmdRepair
    • Caption: Repair/Compact
    • Tab Index: 1
    • Left: 0.3021"
    • Top: 3.25"
    • Width: 1.4271"

    • Height: 0.2292"

12. Change the following properties of the right-side Command Button:

    • Name: cmdClose
    • Caption: Quit
    • Tab Index: 1
    • Left: 2.0833"
    • Top: 3.25"
    • Width: 1.4271"
    • Height: 0.2292"

13. Change the Properties of the Form. Click on the left top corner of the Form where the left-side and Top design guides (Scales) meet. When you click there a blue square will appear, indicating that the Form is selected. Display the Property Sheet and click on the All Tab, if that is not the current one, change the following Properties:

    • Caption: External Repair/Compact Utility
    • Default View: Single Form
    • Views Allowed: Form
    • Allow Edits: Yes
    • Allow Deletions: No
    • Allow Additions: No
    • Data Entry: No
    • Scroll Bars: Neither
    • Record Selectors: No
    • Navigation Buttons: No
    • Dividing Lines: No
    • Auto Resize: Yes
    • Auto Center: Yes
    • Pop up: Yes
    • Modal: Yes
    • Border Style: Dialog
    • Control Box: Yes
    • Min, Max Buttons: None
    • Close Button: Yes
    • Width: 3.9063"

14. Click on the Detail Section of the Form, and change the Height Property:

    • Height: 3.7917"

15. Create a Header Label at the top with the Caption Compacting Utility and change the Font Size to 18 Points or size to your liking.

    NB: If you would like to create a Heading with 3D style characters like the sample shown above, visit the Page Create 3D Heading on Forms and follow the procedure explained there. This you can do it later also.

16. Select the Rectangle Tool from the Toolbox and draw a Rectangle around the Controls as shown on the Design.
    

    Form Class Module Code.

17. Display the VBA Module of the Form (View - - > Code), Copy, and Paste the following code into it, and save the Form with the name Compacting.

    Private Sub cmdClose_Click()
    If MsgBox("Shut Down...?", vbYesNo + vbDefaultButton2 + vbQuestion, _"cmdQuit_Click()") = vbYes Then
        DoCmd.Quit
    End If
    End Sub
    
    Private Sub cmdRepair_Click()
    Dim lst As ListBox, lstcount As Integer
    Dim j As Integer, xselcount As Integer
    Dim dbname As String, t As Double, fs, f
    Dim ldbName As String, strtmp As String
    
    'create a temporary folder C:\tmp, if not present
    On Error Resume Next
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder("c:\tmp")
        If Err = 76 Or Err > 0 Then
           Err.Clear
           fs.createfolder ("c:\tmp")
        End If
    
    On Error GoTo cmdRepair_Click_Err
    
    Me.Refresh
    Set lst = Me.dbList
    lstcount = lst.ListCount - 1
    
    xselcount = 0
    For j = 0 To lstcount
    If lst.Selected(j) Then
        xselcount = xselcount + 1
    End If
    Next
    
    If xselcount = 0 Then
       MsgBox "No Database(s)Selected."
       Exit Sub
    End If
    
    If MsgBox("Ensure that Selected Databases are not in Use. " _
    & vbCrLf & "Proceed...?", vbYesNo + vbDefaultButton2 + vbQuestion, "cmdRepair_Click()") = vbNo Then
       Exit Sub
    End If
    
    For j = 0 To lstcount
        If lst.Selected(j) Then
          dbname = lst.Column(1, j)
           dbname = Trim(dbname)
           ldbName = Left(dbname, Len(dbname) - 3)
           ldbName = ldbName & "ldb" 'for checking the presense of lock file.
           If Len(Dir(ldbName)) > 0 Then 'database is active
              MsgBox "Database: " & dbname v vbCrLf & "is active. Skipping to the Next in list."
              GoTo nextstep
           End If
    
           If MsgBox("Repair/Compact: " & dbname & vbCrLf & "Proceed...?", vbQuestion + vbDefaultButton2 + vbYesNo, "cmdRepair_Click()") = vbYes Then
                Me.lblMsg.Visible = True
                Me.lblStat.Caption = "Working, Please wait..."
                Me.lblStat.Visible = True
                DoEvents
    
                dbCompact dbname 'run compacting
    
                Me.lblStat.Caption = ""
                DoEvents
    
    nextstep:
                t = Timer
                Do While Timer <= t + 7 'delay loop
                   DoEvents 'do nothing
                Loop
            End If
        End If
    Next
    
       Me.lblMsg.Visible = False
       Me.lblStat.Caption = ""
       Me.lblStat.Visible = False
    
    strtmp = "c:\tmp\db1.mdb" 'Delete the temporary file
    If Len(Dir(strtmp)) > 0 Then
      Kill strtmp
    End If
    
    Set fs = Nothing
    Set f = Nothing
    Set lst = Nothing
    
    cmdRepair_Click_Exit:
    Exit Sub
    
    cmdRepair_Click_Err:
    MsgBox Err.Description, , "cmdRepair_Click()"
    Resume cmdRepair_Click_Exit
    End Sub
    

    
    

    Private Function dbCompact(ByVal strdb As String)
    Dim t As Long
    Dim xdir As String, strbk As String
    Const tmp As String = "c:\tmp\"
    
    On Error GoTo dbCompact_Err
    
    If Len(Dir(tmp & "db1.mdb")) > 0 Then
        Kill tmp & "db1.mdb"
    End If
    
    t = InStrRev(strdb, "\")
    If t > 0 Then
       strbk = Mid(strdb, t + 1)
    End If
    strbk = tmp & strbk
    
    xdir = Dir(strbk)
    If Len(xdir) > 0 Then
       Kill strbk
    End If
    'Make a Copy in c:\tmp folder as safe backup
    Me.lblMsg.Caption = "Taking Backup of " & strdb & vbCrLf _
    & "to " & tmp
    DoEvents
    
       DBEngine.CompactDatabase strdb, strbk
    
    Me.lblMsg.Caption = "Transferring Objects from " & strdb & vbCrLf _
    & "to " & tmp & "db1"
    DoEvents
    
       DBEngine.CompactDatabase strdb, tmp & "db1.mdb"
    
    ' Delete uncompacted Database and Copy Compacted db1.mdb with
    ' the Original Name
    
    lblMsg.Caption = "Creating " & strdb & " from " & tmp & "db1.mdb"
    DoEvents
    
        If Len(Dir(strdb)) > 0 Then
            Kill strdb
        End If
    
        DBEngine.CompactDatabase tmp & "db1.mdb", strdb
    
    lblMsg.Caption = strdb & " Compacted Successfully." & vbCrLf & "Database backup copy saved at Location: " & tmp
    DoEvents
    
    dbCompact_Err_Exit:
    Exit Function
    
    dbCompact_Err:
    MsgBox Err & " : " & Err.Description, , "dbCompact()"
      Resume dbCompact_Err_Exit
    End Function
    

    You can set the Compacting Form to open at Startup. Select Startup from Tools Menu. Select the Form Compacting in the Display Form/Page Control. If you want to hide the Database Window then remove the checkmark from the Display Database Window Option.

    The Trial Run

18. Open the Compacting Form in Normal view. Select one or more Databases from the List Box for Compacting.
19. Click the Repair/Compact Command Button.

If you are running the Program for the first time it will check for the presence of a Folder c:\tmp. If it is not present, then it will be created. This folder will be used as Work-Area for the Compacting Utility irrespective of from where you are running this Program (from Server or from Local Drive) and places the Backup Copies of the Compacted Databases.

The program runs a check on each selected database before running the Compacting Procedure to re-confirm that nobody is using it. If it does, then it will display a message as such and will not Compact that Database.

The Label Controls that we have created and kept hidden under the List Box, will be visible now. It will be updated with the program's current activity information, at different stages of the Compacting Procedure.

Any suggestions for improvement of this Program are welcome.

The Demo Database is upgraded to MS-Access Version 2016 and can be downloaded from the link given below.

Download Repairing.zip

• Transparent Command Buttons
• Colorful Command Buttons
• Double Action Command Button
• Sending Alerts to Workstations
• Refresh Dependent Combo Box Contents