的MS Access Jet数据库编程紧凑

Question

编号：Access "Compact and Repair" programatically

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

环境
Win 7的32位
喷气4.x的格式
application.exe原代码语言未知

---

我有安装Jet引擎 - 但让我们假装它不作为场景要求

自动化在这里结束了。

我读过上述提到的链接“Access "Compact and Repair" programatically”

我真的不是一个编码器 - 所以我花了约2-3小时试图让所有的工作中，我悲惨地失败了。 （

我的要求 - 如果你能帮助，请 我需要全“复制和过去的代码” - 我的手指从Dyslexiconica遭受;）我只是不能在这个级别的代码。

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

感谢您的帮助。

非常问候， 文森特

Answer 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)