MS Access Jet Database programatically compact

Question

Ref: Access "Compact and Repair" programatically

HI Guys, I'm looking for a way to run a batch script via scheduled task to compact and or repair a "Jet" .mdb file / database.

Environment
Win 7 32 bit
Jet 4.x format
application.exe Original code language unknown

---

I do have the Jet Engine installed - but lets pretend it's not as a scenario request

Automation is the end game here.

I've read the afore mentioned link "Access "Compact and Repair" programatically"

I'm really not a coder - so I spend about 2-3 hours trying to make all of that work, I failed miserably. : (

My request - if you can help, please . I'll need full "copy and past code" - my fingers suffer from Dyslexiconica ; ) I just can't code at this level.

I can make a simple batch file run successfully. I don't care if it is VBA or straight command line- but you'll have to instruct me on how to make it work.

Thanks for any and all help.

Very best regards, Vincent

Answer 1

Here is a jazzed up version of the compact on close, which displays messages for common problems; for example, for when the source file does not exist; when the source file has an invalid filename extension; and when the destination file exists (it mustn't).

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

Here is another Compact/Repair function below, but not advisable to do arbitrarily on every close - just replace/remove my on error code with your own

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 the function as such:

Call RepairDatabase(strSource, strDestination)