Compact Access Database

Vishesh's picture
'Copy the following code in a general module and call it with required parameters.
'This function returns 0 is successful else error number is returned

Option Explicit
Function CompactDB_JRO(strDBPath As String, Optional strDBPass As String = "") As Long
On Error GoTo ErrFailed
    'Delete the existing temp database
    If Len(Dir$(strDBPath & ".tmp")) Then
        VBA.Kill strDBPath & ".tmp"
    End If
    With CreateObject("JRO.JetEngine")
        If strDBPass = "" Then 'DB without password
            .CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" &  _
             strDBPath, "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDBPath & ".tmp;Jet  _
             OLEDB:Encrypt Database=True"
        Else             'Password protected db
            .CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" &  _
              strDBPath & ";Jet OLEDB:Database Password=" &  _
              strDBPass, "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDBPath & ".tmp;Jet  _
              OLEDB:Encrypt Database=True;Jet OLEDB:Database Password=" & strDBPass
        End If
    End With
On Error GoTo 0
    VBA.Kill strDBPath 'Delete the existing database
    Name strDBPath & ".tmp" As strDBPath 'Rename the compacted database
    CompactDB_JRO = Err.Number
End Function
Vishesh's picture

Compact Access 2003/2007 Database

Pass the full path of the db in the following proc...

Sub CompactAnyAccessDB2003or2007(strDBpath As String)
'You need to have MS Access installed---------------------
CreateObject("WScript.Shell").Run """MSACCESS.EXE"" """ & strDBpath & """ /compact"
End Sub

Compact Database

dint knew this is possible from excel i to do it manually from access itself in all my projects. we will be using it more regularly in our office tools that we prepare for our clients as they have been asking for this utility for a long time and they have to do it manually. Ooh! finally solved.