如何使用代码使用密码加密访问?

How to encrypt Access with password using code?

我创建了一个 Deploy Access 文件,用于部署我的生产 Access 文件。这将表重新链接到生产 SQL 服务器,包括禁用 Shift,添加新版本号....我还需要使用密码加密生产访问文件。这应该使用我的 Deploy Access 文件中的代码来完成,但我找不到执行此操作的方法。有任何想法吗?谢谢。

试试这个功能:

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