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

Posted 2023-05-07

【中文标题】MS Access Jet 数据库以编程方式紧凑

【英文标题】：MS Access Jet Database programatically compact

【发布时间】：2016-10-28 21:30:13

【问题描述】：

参考：Access "Compact and Repair" programatically

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

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

---

我确实安装了 Jet 引擎 - 但我们假设它不是场景请求

自动化是终极目标。

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

我真的不是编码员 - 所以我花了大约 2-3 个小时来完成所有这些工作，但我失败了。 : (

我的请求 - 如果您能提供帮助，请。 我需要完整的“复制和过去的代码” - 我的手指患有阅读障碍； ) 我只是不能在这个级别上编码。

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

感谢您的任何帮助。

最好的问候， 文森特

【问题讨论】：

抱歉，*** 不是代码编写服务 - 请保留问题 on topic 并考虑询问更合适的 Stack Exchange Site

【参考方案1】：

这里是关闭时的简洁版本，它显示常见问题的消息；例如，当源文件不存在时；当源文件具有无效的文件扩展名时；并且当目标文件存在时（它不能存在）。

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

下面是另一个压缩/修复功能，但不建议在每次关闭时都随意执行 - 只需用您自己的替换/删除我的错误代码

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)

【讨论】：

非常感谢。我会检查一下。最好的问候，