压缩修复指定数据库的函数

竹笛

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