Question

参考：Access "Compact and Repair" programatically

HI Guys，我正在寻找一种方法来通过计划任务运行批处理脚本来压缩和修复“Jet”.mdb文件/数据库。

环境
赢7 32位
Jet 4.x格式
application.exe原始代码语言未知

我确实安装了Jet Engine - 但是我们假装它不是一个场景请求

自动化是最终的游戏。

我已阅读上述链接“Access "Compact and Repair" programatically”

我真的不是一个程序员 - 所以我花了大约2-3个小时试图完成所有这些工作，我失败了。 :(

我的要求 - 如果你能提供帮助，请。我需要完整的“复制和过去的代码” - 我的手指患有Dyslexiconica;我只是不能在这个级别编码。

我可以成功运行一个简单的批处理文件。我不在乎它是VBA还是直接命令行 - 但是你必须告诉我如何让它工作。

感谢您的帮助。

非常好的问候，文森特

Answer 1

这是一个关闭的紧凑版本的jazzed up版本，它显示常见问题的消息;例如，当源文件不存在时;当源文件的文件扩展名无效时;当目标文件存在时（不得）。

Option Compare Database
Option Explicit

'   Declare an enumeration of long integer
'   constants, to be used as the return values
'   for the RepairDatabase() function.
'   As Access's CompactRepair() method returns
'   TRUE or FALSE, the Enum uses -1 (TRUE) for
'   success and 0 for failure.
Public Enum ryCompactResult
    cmpCompactSuccessful = -1
    cmpCompactFailed = 0
    cmpErrorOccurred = 1
    cmpSourceFileDoesNotExist = 2
    cmpInvalidSourceFileNameExtension = 3
    cmpDestinationFileExists = 4
End Enum


Private Sub TestRepair()

    Dim strSource As String
    Dim strDestination As String
    Dim lngRetVal As ryCompactResult

    strSource = "C:\MyFolder\db1.mdb"
    strDestination = "C:\MyFolder\db2.mdb"

    '   Call the function:
    lngRetVal = RepairDatabase(strSource, strDestination)

    '   Examine the return value from the function
    '   and display appropriate message:
    Select Case lngRetVal

    Case cmpCompactSuccessful
        MsgBox "Compact & repair successful.", _
            vbOKOnly + vbInformation, _
            "Program Information"

    Case cmpSourceFileDoesNotExist
        MsgBox strSource & vbNewLine & vbNewLine _
            & "The above file does not exist.", _
            vbOKOnly + vbExclamation, _
            "Program Finished"

    Case cmpInvalidSourceFileNameExtension
        MsgBox strSource & vbNewLine & vbNewLine _
            & "The above file has an invalid filename " _
            & "extension.", vbOKOnly + vbExclamation, _
            "Program Finished"

    Case cmpDestinationFileExists
        MsgBox strDestination & vbNewLine & vbNewLine _
            & "The above destination file exists. " _
            & vbNewLine _
            & "Please delete the above file or " _
            & "use a different destination filename.", _
            vbOKOnly + vbExclamation, "Program Finished"

    Case cmpErrorOccurred
        '   The RepairDatabase() function has
        '   already displayed an error message.

    End Select


End Sub

Function RepairDatabase( _
    strSource As String, _
    strDestination As String) As ryCompactResult

    ' IN:
    '
    '   strSource:
    '       The full path to the database that is
    '       to be compacted.
    '
    '   strDestination:
    '       The full path to the resultant database
    '       after strSource has been compacted.
    '
    ' OUT:
    '
    '   This function returns one of the values in
    '   the ryCompactResult Enum.


    Dim lngRetVal As ryCompactResult
    Dim strFileName As String
    Dim strFileNameExtn As String
    Dim lngPos As Long


On Error GoTo Error_RepairDatabase

    '   See if source file exists:
    strFileName = Dir(strSource)
    If Len(strFileName) = 0 Then
        lngRetVal = cmpSourceFileDoesNotExist
        GoTo Exit_RepairDatabase
    End If

    '   See if source filename has appropriate
    '   filename extension (mdb or accdb).
    '   First, see if filename contains a period:
    lngPos = InStr(strFileName, ".")
    If lngPos = 0 Then
        '   Period not found in filename;
        '   i.e. no filename extension found.
        lngRetVal = cmpInvalidSourceFileNameExtension
        GoTo Exit_RepairDatabase
    Else
        '   Get filename extension:
        strFileNameExtn = Mid(strFileName, lngPos + 1)
        strFileNameExtn = LCase(strFileNameExtn)

        Select Case strFileNameExtn
        Case "mdb", "accdb"
            '   Correct filename extension found.
            '   We can proceed with compact & repair.
        Case Else
            '   Invalid filename extension found.
            lngRetVal = cmpInvalidSourceFileNameExtension
            GoTo Exit_RepairDatabase
        End Select
    End If

    '   Destination file must not exist:
    strFileName = Dir(strDestination)
    If Len(strFileName) > 0 Then
        lngRetVal = cmpDestinationFileExists
        GoTo Exit_RepairDatabase
    End If

    '   Compact and repair database:
    lngRetVal = Application.CompactRepair( _
                strSource, strDestination, True)

Exit_RepairDatabase:

    RepairDatabase = lngRetVal
    Exit Function

Error_RepairDatabase:

    lngRetVal = cmpErrorOccurred
    MsgBox "Error No: " & Err.Number _
        & vbNewLine & vbNewLine _
        & Err.Description, _
        vbOKOnly + vbExclamation, _
        "Error Information"

    Resume Exit_RepairDatabase

End Function

下面是另一个Compact / Repair功能，但不建议在每次关闭时随意执行 - 只需用您自己的

替换/删除我的错误代码

Function RepairDatabase(strSource As String, _
        strDestination As String) As Boolean
        ' Input values: the paths and file names of
        ' the source and destination files.

Dim strSource As String
Dim strDestination As String

strSource = "\\Dg\Debt \2010\Summary\Summary.mdb"
strDestination = "\\Dg\Debt \2010\Summary\Summary_Compact.mdb"

    ' Trap for errors.
    On Error GoTo ErrorRoutine

    ' Compact and repair the database. Use the return value of
    ' the CompactRepair method to determine if the file was
    ' successfully compacted.
    RepairDatabase = _
        Application.CompactRepair( _
        LogFile:=True, _
        SourceFile:=strSource, _
        DestinationFile:=strDestination)

    ' Reset the error trap and exit the function.
    On Error GoTo 0
    Exit Function

' Return False if an error occurs.
Exit_Function:
    Exit Function
ErrorRoutine:
    RepairDatabase = False
    Call LogError(Err.Number, Err.Description, conMod & ".RepairDatabase", , True)
    Resume Exit_Function
End Function

Call the function as such:
Call RepairDatabase(strSource, strDestination)

按原样调用该函数：

Call RepairDatabase(strSource, strDestination)

MS Access Jet数据库以编程方式紧凑

1 个答案: