vb6压缩Access数据库使用JRO.JetEngine

引用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