用DAO可以实现!Sub CompactDatabaseX()    Dim dbsNorthwind As Database    Set dbsNorthwind = OpenDatabase("Northwind.mdb")    ' Show the properties of the original database.
    With dbsNorthwind
        Debug.Print .Name & ", version " & .Version
        Debug.Print "    CollatingOrder = " & .CollatingOrder
        .Close
    End With    ' Make sure there isn't already a file with the
    ' name of the compacted database.
    If Dir("NwindKorean.mdb") <> "" Then Kill "NwindKorean.mdb"    ' This statement creates a compact version of the
    ' Northwind database that uses a Korean language
    ' collating order.
    DBEngine.CompactDatabase "Northwind.mdb", 
        "NwindKorean.mdb", dbLangKorean    Set dbsNorthwind = OpenDatabase("NwindKorean.mdb")    ' Show the properties of the compacted database.
    With dbsNorthwind
        Debug.Print .Name & ", version " & .Version
        Debug.Print "    CollatingOrder = " & .CollatingOrder
        .Close
    End WithEnd Sub

解决方案 »

  1.   

    或引用JET AND REPLICATION OBJECT 2。5对象!Dim JRO As JRO.JetEngineSet JRO = New JRO.JetEngineDim fsSet fs = CreateObject("Scripting.FileSystemObject")If fs.FileExists(App.Path & "\backup\mlc.mdb") Then fs.DeleteFile App.Path & "\backup\mlc.mdb"JRO.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\mlc.mdb", "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\backup\mlc.mdb;Jet OLEDB:Engine Type=4"  '來源文件'目的文件Dim fs2Set fs2 = CreateObject("Scripting.FileSystemObject")If fs2.FileExists(App.Path & "\mlc.mdb") Then fs2.DeleteFile App.Path & "\mlc.mdb"fs2.copyfile App.Path & "\backup\mlc.mdb", App.Path & "\mlc.mdb"Set dbs = OpenDatabase(App.Path & "\mlc.mdb")MsgBox "数据库压缩成功", 64, "压缩完成"
      

  2.   

    偶用ADO试过多次,压缩后的数据库有问题,建议用Dao
      

  3.   

    用ado不能压缩,但可以在access里压缩,
      

  4.   

    完全解决方案:http://www.csdn.net/Expert/TopicView1.asp?id=284952