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