Public Function RepairDatabase(strSource As String) As Boolean
    On Error GoTo error_handler
    Dim i As Integer
    '生成压缩后的文件名
    Dim strDestination As String
    i = 1
    Do
        strDestination = strSource & i
        If Dir(strSource & i) = "" Then
            Exit Do
        Else
            i = i + 1
        End If
    Loop
    '压缩修复指定文件
    RepairDatabase = _
    Application.CompactRepair( _
                              LogFile:=True, _
                              SourceFile:=strSource, _
                              DestinationFile:=strDestination)
    '压缩完成后删除原文件
    Kill strSource
    '把压缩后的文件名改成原文件名
    Name strDestination As strSource
    On Error GoTo 0
    Exit Function
error_handler:
    RepairDatabase = False
End Function