是否可以在 MS Access 中对设计视图进行密码保护？还是通过代码？

Posted 2023-03-28

【中文标题】是否可以在 MS Access 中对设计视图进行密码保护？还是通过代码？

【英文标题】：Is it possible to password protect Design view in MS Access? or through code?

【发布时间】：2020-03-03 06:16:53

【问题描述】：

我已经搜索过类似的问题，但没有得到我想要的答案。

我正在尝试使用 VBA 代码禁用 MS Access 功能区工具栏中的设计视图选项，以便用户无法访问它。我正在使用 MS Access 2007。

我已经尝试了here 提供的代码，但这对我不起作用。

我也尝试过 File->options 方法从功能区中删除设计视图。但是通过这一步，用户只需很少上网就可以返回设计视图，因此不会选择此解决方案。

有没有办法让设计视图密码保护就像我们对代码部分所做的那样？

【参考方案1】：

在没有数据库的情况下打开 Access 程序

现在选择菜单文件 -> 打开

在文件打开对话框的右下角，取消按钮的左侧，将“打开”下拉菜单更改为“以独占方式打开”

按住左 Shift 键，这样您的启动代码就不会运行

现在选择您的数据库文件，然后单击“打开”按钮（在您已将其下拉菜单更改为“以独占方式打开”之后）

现在单击 Office 2013 功能区下的“文件”菜单。

有一个非常大的按钮，上面写着“使用密码加密”。

单击它并输入您的秘密数据库密码。

点击“确定”按钮后关闭数据库并重新打开。

现在没有人可以更改表单设计（除非他们知道您设置的密码）

【讨论】：

嗨，迈克，这会创建密码来保护代码。我正在设计视图中寻找密码保护，我们在其中拖放按钮和文本框等。

将 .accdb 转换为内部加密的 .accde 并且表单不可编辑（即使您自己也无法编辑，因此请保留原始 .accdb 用于开发并将 .accde 发布给您的最终用户）

【参考方案2】：

您有几个选项可以“保护”设计视图。正如一条评论所建议的那样，您可以为您的用户部署一个 accde 版本 - 但这消除了在文件中的设计视图中访问的任何可能性，因此如果您的用户有一个奇怪的错误，您必须将他们部署为“解锁' accdb 来查找问题。此外，您需要使用用户拥有的正确位版本来编译 accde 以使 accde 工作。例如，如果您拥有 32 位版本的访问权限，但您的用户拥有 64 位（或反向）版本，则 accde 将不会运行。所以，我建议用设置和一些代码来屏蔽它。

我已经在部署文件之前运行了一个“安全”功能 - 我在我的机器上保留了一个“解锁”开发副本，以及一个可以以编程方式“解锁”访问文件的“解锁器”文件.我已经将它与 2010、2013、2016 和 365 一起使用 - 所以我想它应该与 2007 一起使用。

我将我的代码放在下面，如果您有任何问题，请告诉我。

代码如下：

    Public Function UpdateDatabaseFileProperties( _
        sDatabaseFile As String _
        , bEnable As Boolean _
        ) As Boolean

    '   Error Direction
                                                        '
        On Error GoTo ErrorHandling
                                                        '
    '   Declare
                                                        '
        Dim AccObj As Access.Application
                                                        ' an array to hold the properties to change
        Dim arrProperty() As Variant
                                                        ' a counter to run through the permissions list
        Dim iCounter As Integer
                                                        '
    '   Set
                                                        ' an array of properties to change
        arrProperty = Array( _
            "StartupShowStatusBar" _
            , "AllowBuiltInToolbars" _
            , "StartupShowDBWindow" _
            , "AllowFullMenus" _
            , "AllowBreakIntoCode" _
            , "AllowSpecialKeys" _
            , "AllowByPassKey" _
            , "AllowShortcutMenus" _
            , "AllowDatasheetSchema" _
            )
                                                        ' set the access object
        SetAccessFileObject AccObj, sDatabaseFile, True, False, False
                                                        '
    '   Use Variables
                                                        '
        For iCounter = LBound(arrProperty) To UBound(arrProperty)
                                                        ' change the property of the database
            ChangeDatabaseProperty CStr(arrProperty(iCounter)), dbBoolean, bEnable, AccObj, True, False
                                                        ' go to the next property
        Next iCounter
                                                        ' set the navigation pane lock
        AccObj.DoCmd.LockNavigationPane bEnable
    ' close the file when complete
        CloseAccessDatabaseFile AccObj
                                                        '
    ExitCodeBlock:
                                                        '
    '   Clear Variables
                                                        '
        Exit Function
                                                        '
    '   Error Handling
                                                        '
    ErrorHandling:
                                                        '
        ErrorHandler Err.Number, Err.Description, lModuleID, 0
                                                        '
    End Function

Public Function ChangeDatabaseProperty( _
    sPropertyName As String _
    , vPropertyType As Variant _
    , vPropertyValue As Variant _
    , AccObj As Access.Application _
    , Optional bLeaveOpenAfterEdit As Boolean = False _
    , Optional bGiveUserControl As Boolean = False _
    ) As Boolean
                                                    '
'   Error Direction
                                                    '
    On Error GoTo ErrorHandling
                                                    '
'   Declare
                                                    '
    Dim dbs As DAO.Database
                                                    '
    Dim prp As DAO.Property
                                                    '
    'Dim AccObj As Access.Application
                                                    '
'   Set
                                                    ' set the database object
    Set dbs = AccObj.CurrentDb
                                                    '
'   Use Variables
                                                    ' set the property value
    dbs.Properties(sPropertyName).Value = vPropertyValue
                                                    ' if the file should not be left open after the changes are made
    If bLeaveOpenAfterEdit = False Then
                                                    ' quit the file and save all changes
        AccObj.Quit acQuitSaveAll
                                                    ' if the database file does not equal blank and it should be left open
    ElseIf bLeaveOpenAfterEdit = True And bGiveUserControl = True Then
                                                    ' provide control to the user
        AccObj.UserControl = True
        
        AccObj.Visible = True
                                                    '
    End If
                                                    '
ExitCodeBlock:
                                                    '
'   Clear Variables
                                                    '
    Set dbs = Nothing
                                                    '
    Set prp = Nothing
    
    If bLeaveOpenAfterEdit = False Then
                                                    '
        Set AccObj = Nothing
    
    End If
                                                    '
    Exit Function
                                                    '
'   Error Handling
                                                    '
ErrorHandling:
                                                    ' depending on the error experienced
    Select Case Err.Number
                                                    ' 3270 = property does not exist
        Case 3270
                                                    '
            Set prp = dbs.CreateProperty(sPropertyName, vPropertyType, vPropertyValue)
                                                    '
            dbs.Properties.Append prp
                                                    '
            Resume Next
                                                    ' in any other error
        Case Else
                                                    '
            ErrorHandler Err.Number, Err.Description, lModuleID, 0
                                                    '
            Resume ExitCodeBlock
                                                    '
    End Select
                                                    '
End Function