' 压缩 Access 数据库
Public Sub CompactJetDatabase(SourceFile As String, Optional Password As String, Optional BackupOriginal As Boolean = True)
On Error GoTo CompactErr
Dim strBackupFile As String
Dim strTempFile As String
' 判断来源文件是否存在
If Dir(SourceFile) <> "" Then
' 如果需要备份原文件
If BackupOriginal = True Then
strBackupFile = GetSourceFilePath(SourceFile) & "Backup.mdb"
If Dir(strBackupFile) <> "" Then
Kill strBackupFile
End If
FileCopy SourceFile, strBackupFile
End If
' 建立压缩文件名
strTempFile = GetSourceFilePath(SourceFile) & "Temp.mdb"
If Dir(strTempFile) <> "" Then
Kill strTempFile
End If
'安装Microsoft ActiveX Data Objects 2.X library (X为1以上)
'引用Microsoft Jet and Replication Objects 2.X library
Dim jro As jro.JetEngine
Set jro = New jro.JetEngine
jro.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=d:\test\test.mdb", _
"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=d:\test\new.mdb;"