Private Sub CompactDataBase(DataBasePath, boolIs97)
On Error Resume Next
Dim Fso, Engine, strDataBasePath,JET_3X
strDataBasePath = Left(DataBasePath,InstrRev(DataBasePath,""))
Set Fso = CreateObject("Scripting.FileSystemObject")
If Err.Number <> 0 Then
Err.Clear()
Exit Sub
End If
If Fso.FileExists(DataBasePath) Then
Fso.CopyFile DataBasePath,strDataBasePath & "CompactDBTemp.mdb"
Set Engine = CreateObject("JRO.JetEngine")
If BoolIs97 = "True" Then
Engine.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDataBasePath & "CompactDBTemp.mdb", _
"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDataBasePath & "CompactDBTemp1.mdb;" _
& "Jet OLEDB:Engine Type=" & JET_3X
Else
Engine.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDataBasePath & "CompactDBTemp.mdb", _
"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDataBasePath & "CompactDBTemp1.mdb"
End If
Fso.CopyFile strDataBasePath & "CompactDBTemp1.mdb",DataBasePath
Fso.DeleteFile(strDataBasePath & "CompactDBTemp.mdb")
Fso.DeleteFile(strDataBasePath & "CompactDBTemp1.mdb")
Set Fso = nothing
Set Engine = nothing
If Err.Number <> 0 Then
Err.Clear()
Exit Sub
End If
End If
End Sub
End Class
%>
