How to encrypt Access with password using code? - ms-access

Question

I created a Deploy Access file which I use to deploy my production Access file. This re-links tables to production SQL server, incorporates disabling use of Shift, add new version number.... I need also encrypt the production Access file with a password. This should be done using code in my Deploy Access file but I cannot find a way to do it. Any ideas? Thanks.

Answer 1

Try this function:
Public Function SetDatabasePassword(strDatabasePath As String, Optional pNewPassword As Variant, Optional pOldPassword As Variant) As String
On Error GoTo SetDatabasePassword_Error
DoCmd.Hourglass True
Const cProvider = "Microsoft.ACE.OLEDB.12.0"
Dim cnn As ADODB.Connection
Dim strNewPassword As String
Dim strOldPassword As String
Dim strCommand As String
Dim strResult As String
' If a password is not specified (IsMissing), ' the string is "NULL" WITHOUT the brackets
If IsMissing(pNewPassword) Then
strNewPassword = "NULL"
Else
strNewPassword = "[" & pNewPassword & "]"
End If
If IsMissing(pOldPassword) Then
strOldPassword = "NULL"
Else
strOldPassword = "[" & pOldPassword & "]"
End If
strCommand = "ALTER DATABASE PASSWORD " & strNewPassword & " " & strOldPassword & ";"
Set cnn = New ADODB.Connection
With cnn
.Mode = adModeShareExclusive
.Provider = cProvider
If Not IsMissing(pOldPassword) Then
.Properties("Jet OLEDB:Database Password") = pOldPassword
End If
.Open "Data Source=" & strDatabasePath & ";"
.Execute strCommand
End With
strResult = "Password Set"
ExitProc_:
On Error Resume Next
cnn.Close
Set cnn = Nothing
SetDatabasePassword = strResult
DoCmd.Hourglass False
Exit Function
SetDatabasePassword_Error:
DoCmd.Hourglass False
If Err.Number = -2147467259 Then
strResult = "An error occured"
ElseIf Err.Number = -2147217843 Then
strResult = "Invalid password"
Else
strResult = Err.Number & " " & Err.Description
End If
Resume ExitProc_
Resume ' use for debugging
End Function