Option Explicit

Private Sub Command1_Click()
    Dim sText As String
    sText = Compact("c:\myFile.mdb", "mypass")
    If Len(sText) Then
        Debug.Print sText
    Else
        Debug.Print "Compacted"
    End If
End Sub

Public Function Compact(Source As String, _
    Password As String) As String
On Error GoTo ErrHandler:
    Dim objJet As JRO.JetEngine
    Dim Destination As String
    Static Compacting As Boolean
    If Right(LCase(Source), 4) = ".mdb" And Not Compacting Then
        Compacting = True
        If LenB(Dir$(Source)) > 0 Then
            Destination = App.Path & "\" & Format(Now, "hhmmssmmddyy") & ".tmp"
            If LenB(Dir$(Destination)) Then Kill Destination
            Set objJet = New JRO.JetEngine
            DoEvents: objJet.CompactDatabase _
                "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & Source & ";" & _
                "Jet OLEDB:Database Password=" & Password & ";", _
                "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & Destination & ";" & _
                "Jet OLEDB:Database Password=" & Password & ";"
            Set objJet = Nothing
            Kill Source: Name Destination As Source
            Compact = vbNullString
        Else
            Compact = "FILE PATH ERROR"
        End If
        Compacting = False
    Else
        If Compacting Then
            Compact = "BUSY COMPACTING"
        Else
            Compact = "INVALID DATABASE"
        End If
    End If: Exit Function
ErrHandler:
    Set objJet = Nothing
    Compact = UCase(Err.Description)
    Compacting = False
End Function