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

时　间:2008-07-04 09:06:28
作　者:李寻欢   ID：2712  城市：深圳
摘　要:压缩修复指定数据库的函数
正　文:

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

Access软件网QQ交流群 (群号:54525238) 　　　　　　Access源码网店