VBA/Excel/Access/Word/Access/Database Encrypt

Encrypting a Database

 
Sub EncryptDb()
    Dim jetEng As JRO.JetEngine
    Dim strCompactFrom As String
    Dim strCompactTo As String
    Dim strPath As String
    strPath = CurrentProject.Path & "\"
    strCompactFrom = "mydb.mdb"
    strCompactTo = "mydb__.mdb"
    On Error GoTo HandleErr
    Set jetEng = New JRO.JetEngine
    jetEng.rupactDatabase "Data Source=" & _
           strPath & strCompactFrom & ";", _
           "Data Source=" & strPath & strCompactTo & ";" & _
           "Jet OLEDB:Encrypt Database=True"
ExitHere:
    Set jetEng = Nothing
    Exit Sub
HandleErr:
    MsgBox Err.Number & ": " & Err.Description
    Resume ExitHere
End Sub