Compact and Repair an Access Database

Sub CompactDB()

    MsgBox RepairDatabase("C:\Path\To\AccessDB\Filename.accdb", _
        "C:\Path\To\AccessDB\Filename_temp.accdb")

End Sub

Function RepairDatabase(strSource As String, strDestination As String) As Boolean

    On Error GoTo error_handler

    RepairDatabase = Application.CompactRepair( _
        SourceFile:=strSource, _
        DestinationFile:=strDestination, _
        LogFile:=False _
    )

    If RepairDatabase = True Then
        ' Delete the original file
        SetAttr strSource, vbNormal
        Kill strSource

        ' Rename the compacted DB to the orignal DB name
        SetAttr strDestination, vbNormal
        Name strDestination As strSource

    Else
        If Len(Dir(strDestination)) <> 0 Then
            SetAttr strDestination, vbNormal
            Kill strDestination
        End If
    End If

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

    ' Return False if an error occurs.
error_handler:
        RepairDatabase = False

End Function

Running this code may trigger a Microsoft Access Security Notice.  This cannot be disabled through VBA.

To change your security settings go to File –> Options –>Trust Center –> Trust Center Settings…