如何判断Access VBA是否受密码保护

Question

我正在构建一个Access加载项，可以从打开的数据库应用程序导入/导出Access对象。我正在使用未记录的SaveAsText和LoadFromText命令来处理对象。如果 Access应用程序的VBA 上有密码，则命令将失败。我正在寻找一种以编程方式确定我的例程开始之前VBA是否受密码保护的方法。

请注意，该问题不是有关Access数据库本身密码的问题。。我指的是通过VBA项目属性对话框设置的保护，如下图所示。

如果需要Determine if an MS Access Database is Password Protected

，请选中此链接

Answer 1

如果活动的VBA项目受密码保护，则此函数将返回TRUE。

Function ProtectedVBProject() As Boolean
' Returns TRUE if the VBA of the project is password protected.

    Dim VBC As Integer
    VBC = -1
    On Error Resume Next
    VBC = Application.VBE.VBProjects(1).VBComponents.Count ' Project count may be Base 1

    On Error GoTo 0
    If VBC = -1 Then
        ProtectedVBProject = True
    Else
        ProtectedVBProject = False
    End If
End Function

以下是如何调用此函数的示例：

' Stop if the VBA is protected with a password.
If ProtectedVBProject Then
    MsgBox "It appears that the source code is password protected.  Please open" _
        & " the Visual Basic editor and enter the VBA password for the active database." _
        , vbExclamation, "Object Locked!"
    Exit Sub
End If

如果该加载项仅由本人或其他开发人员使用，并且代码未编译为.mde或.accde，则下一个示例为用户提供了一个选项，可以当场输入密码，然后继续。我可能不需要告诉您，在已发布的代码中使用STOP通常是一种不好的做法。

' Stop if the VBA is protected with a password and ask if the user wants to unlock it.
If ProtectedVBProject Then
    Dim strMsg as String
    strMsg = "It appears that the source code is password protected." _
        & vbCrLf & vbCrLf & "Do you want to enter the VBA password now?"

    Select Case MsgBox(strMsg, vbYesNo Or vbExclamation Or vbDefaultButton1, "Object Locked")

        Case vbYes
            '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
            '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
            '=-=-=
            '=-=-=    ENTER THE VBA PASSWORD FOR THE ACTIVE DATABASE
            '=-=-=    THEN PRESS F5 TO RESUME THE CODE EXECUTION
            '=-=-=
            '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
            '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
            Stop        ' Press F5 to continue.  Do not remove this line.

        Case vbNo
            Exit Sub            
    End Select
End If