Public Function CompactDBFile (strDBFileName)
Dim Jet_Conn_Partial
Dim SourceConn
Dim DestConn
Dim oJetEngine
Dim oFSO
Jet_Conn_Partial = "Provider = Microsoft. Jet. OLEDB.4.0; Data source ="
SourceConn = Jet_Conn_Partial & AppPath () & strDBFileName
DestConn = Jet_Conn_Partial & AppPath () & "Temp" & strDBFileName
Set oFSO = Server. CreateObject ("Scripting. FileSystemObject ")
Set oJetEngine = Server. CreateObject ("JRO. JetEngine ")
With oFSO
If Not. FileExists (AppPath () & strDBFileName) Then
ErrMsg ("the database file is not found !!!! ")
Stop
CompactDBFile = False
Exit Function
Else
If. FileExists (AppPath () & "Temp" & strDBFileName) Then
ErrMsg ("unknown error !!! ")
. DeleteFile (AppPath () & "Temp" & strDBFileName)
CompactDBFile = False
Exit Function
End If
End If
End
With oJetEngine
. CompactDatabase SourceConn, DestConn
End
OFSO. DeleteFile AppPath () & strDBFileName
OFSO. MoveFile AppPath () & "Temp" & strDBFileName, AppPath () & strDBFileName
Set oFSO = Nothing
Set oJetEngine = Nothing
CompactDBFile = True
End Function