LEARN MS-ACCESS TIPS AND TRICKS: REPAIRING COMPACTING DATABASE WITH VBA

As far as Microsoft Access is concerned compacting the Database is an essential function to keep the Database size to the minimum. When you work with the Database MS-Access creates temporary work-objects within the Database resulting the file size to expand. We can display some of these temporary objects with VBA Code. Copy and paste the following Code into the Global Module of a Database that was not compacted recently. Press Ctrl+G to open the Debug Window (Immediate Window), click somewhere within the code and press F5 to execute it.


Public Sub tmpObjects()
Dim ctr As Container, doc As Document
Dim cdb As Database, item

Set cdb = CurrentDb
Set ctr = db.Containers("tables")
For Each item In ctr.Documents
   If Left(item.Name, 1) = "~ " Then
      Debug.Print item.Name
   End If
Next
Set db = Nothing
Set ctr = Nothing
End Sub

You will find a listing of temporary work-files, similar to the sample lines given below, in the Debug Window:


~sq_cBRVISIT~sq_cBR
~sq_cBRVISIT~sq_cBRV_Detail
~sq_cBRVISIT~sq_cEMPCOD
~sq_cBRVISIT~sq_cYRMTH

After compacting the Database if you run this code again then these type of objects will not appear at all.

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 Options settings. Select the Menu Tools - -> Options - - > General Tab and put a check mark 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 of the Database to run compacting. When you turn on the Compact on Close feature it will attempt to do that 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 of the Database for compacting because it deletes the original Database in this process and re-creates it. Check the following steps taken by the compacting Procedure:

Select Tools - -> Database Utilities - - > Compact and Repair Database. Closes the Current Database.

Creates a temporary Database with the name db1.mdb in the current folder.

Transfers all the Objects (Tables, Forms, Reports etc.), except the work-objects, into db1.mdb.

Deletes the original Database.

Copies db1.mdb file with the original name.

Deletes the temporary Database db1.mdb

Re-opens the newly created Database.

If a database is not active when you select the option in Step-1 you are asked to select the Source Database from 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 files.

To do compacting on 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 on 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 but with some change in the way the procedure is Run.

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

Uses Local Disk Space for Work-File, which will speed up the process, and extra space on 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 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.

Create a new Database with the name CompUtil.mdb.

Create a Table with the following structure.


Field Name Type  Size
ID  AutoNumber 
dbPath  Text  75

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

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.

Re-size 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.

Property

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

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

Re-size 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.

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

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

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



Name  :  cmdRun

Caption  :  Repair/Compact

Tab Index :  1

Left  :  0.3021"

Top  :  3.25"

Width  :  1.4271"

Height  :  0.2292"

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"

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, and 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"

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


Height  : 3.7917"

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

NB:

Create 3D Heading on Forms

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

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 cmdRun_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 GoTo cmdRun_Click_Err
Set fs = CreateObject("Scripting.FileSystemObject")
f = fs.FolderExists("c:\tmp")
    If f = false Then
         fs.CreateFolder ("c:\tmp")
    End If

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, _
"cmdRun_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 & vbCrLf _
                  & "is active. Skipping to the Next in list."
          GoTo nextstep
       End If
    
       If MsgBox("Repair/Compact: " & dbname & vbCrLf & "Proceed...?", _
                vbQuestion + vbDefaultButton2 + vbYesNo, "cmdRun_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 + 5 'delay loop
                'do nothing
                       Loop
        End If
    End If
Next

   Me.lblMsg.Visible = False
   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

cmdRun_Click_Exit:
Exit Sub

cmdRun_Click_Err:
MsgBox Err.Description, , "cmdRun_Click()"
Resume cmdRun_Click_Exit
End Sub


Private Function dbCompact(ByVal strdb As String)
Dim ErrLoop As Error, t As Long
Dim xdir As String, strbk As String
Const tmp As String = "c:\tmp\"

On Error GoTo Err_Compact

If Dir(tmp & "db1.mdb") <> "" 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 Dir(strdb) <> "" 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

Err_Compact_Exit:
Exit Function

Err_Compact:
  For Each ErrLoop In DBEngine.Errors
    MsgBox "Compacting Unsuccessful!" & vbCr & _
      "Error number: " & ErrLoop.Number & _
      vbCr & ErrLoop.Description
  Next ErrLoop
  Resume Err_Compact_Exit
End Function

Compacting

Startup

Startup

Tools

Compacting

Display Form/Page

Database Window

Display Database Window

Open the Compacting Form in Normal view. Select one or more Databases from the List Box for Compacting.

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 there 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 below 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.