引用msjro.dll控件
' 压缩数据库
Public Function compactDatabase(ByVal DataBase As String)
On Error GoTo err1
Dim str As String
Dim Flag As Integer, FileName As String
Dim FIXDB As New JRO.JetEngine
Flag = InStrRev(DataBase, "\", , vbBinaryCompare)
str = Mid(DataBase, 1, Flag)
FileName = str & "fileMdb.mdb"
FIXDB.compactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & DataBase, _
"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & FileName
Kill DataBase
Name FileName As DataBase '重命名文件
err1:
End Function