compact current msaccess client on close

[ide]

call the following code from the on close event procedure of your main form (or an invisible form what loads when the client starts). I use it on NT and 2000.

'**********************************************************************************
Sub sbCompactCurrentDatabase()
Dim FS, a
Dim strWrite As String, strVBFilePath As String

strVBFilePath = CurrentProject.Path & "\testfile.vbs"

strWrite = "Set objApp = WScript.CreateObject(" & Chr(34) & "Access.Application" & Chr(34) & &quot" & vbCrLf & _
"Set FS = WScript.CreateObject(" & Chr(34) & "Scripting.FileSystemObject" & Chr(34) & &quot" & vbCrLf & _
"k = Now() + TimeSerial(0, 0, 5)" & vbCrLf & _
"While k > Now()" & vbCrLf & _
"Wend" & vbCrLf & _
"On Error Resume Next" & vbCrLf & _
"strFilePath = " & Chr(34) & CurrentProject.Path & "\" & CurrentProject.Name & Chr(34) & vbCrLf & _
"strTempPath = " & Chr(34) & CurrentProject.Path & "\Tmp_" & CurrentProject.Name & Chr(34) & vbCrLf & _
&quot;If FS.FileExists(strTempPath) <> &quot; & Chr(34) & Chr(34) & &quot; Then FS.DeleteFile strTempPath&quot; & vbCrLf & _
&quot;objApp.DBEngine.CompactDatabase strFilePath, strTempPath&quot; & vbCrLf & _
&quot;If FS.FileExists(strTempPath) <> &quot; & Chr(34) & Chr(34) & &quot; Then&quot; & vbCrLf & _
&quot; FS.DeleteFile strFilePath&quot; & vbCrLf & _
&quot; FS.CopyFile strTempPath, strFilePath, True&quot; & vbCrLf & _
&quot; FS.DeleteFile strTempPath&quot; & vbCrLf & _
&quot;End If&quot; & vbCrLf & _
&quot;FS.DeleteFile &quot; & Chr(34) & strVBFilePath & Chr(34)


On Error Resume Next
Call Kill(strVBFilePath)
On Error GoTo 0

Set FS = CreateObject(&quot;Scripting.FileSystemObject&quot

Set a = FS.CreateTextFile(strVBFilePath, True)
a.WriteLine (strWrite)
a.Close

strVBFilePath = &quot;WScript.exe &quot; & Chr(34) & strVBFilePath & Chr(34)
Shell strVBFilePath

Application.Quit acQuitSaveAll
End Sub ide