Access VBA

css navigation by

Compact on Exit

We built this database that contains lots of Built Tables. So big in fact that it is 1.8 GB. With all the gyrations this thing goes through, I was orignally planning to “Compact on Exit” but decided to let the user decide when to compact.
Public Sub AutoCompactCurrentProject()
    Dim fs, f, S, fileSpec
    Dim strProjectPath      As String
    Dim strProjectName      As String
    strStatus = "Please wait! Clean up will continue during shutdown."
    varStatus = SysCmd(acSysCmdSetStatus, strStatus)
    Call SysCmd(504, 16483)     'Compiles all modules
    DoCmd.Hourglass True
    strProjectPath = Application.CurrentProject.Path
    strProjectName = Application.CurrentProject.Name
    fileSpec = strProjectPath & "\" & strProjectName
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFile(fileSpec)
    S = CLng(f.Size / 1000000)  'convert size of app from bytes to Mbís
    Debug.Print S
    If S >= 2000 Then             'edit the 2000 (Mbís) to the max size you want to allow your app to grow.
            varStatus = SysCmd(acSysCmdSetStatus, "File size is " & S _
                & " megabytes and will be compacted!")
        '  1100 = 1.1 Gb
        Application.SetOption ("Auto Compact"), 1  'compact app
        Application.SetOption "Auto Compact", 0   'no donít compact app
    End If
    DoCmd.Hourglass False
    varStatus = SysCmd(acSysCmdClearStatus)
End Sub

Compacting was taking up to 30 minutes even on a fast PC. By warning them to compact, they can set it to work and leave for lunch.

© 2007-2024

Updated:  06/21/2024 07:42
This page added:  17 June 2007