禁用旁路键

时间:2015-03-23 05:25:36

标签: access-vba ms-access-2010

我想在autoexec期间在open form事件上禁用数据库的旁路键,以便用户无法查看表单的基础表。我找到了以下代码并创建了一个模块,可以在auto exec期间打开表单时运行。该模块名为SetBypass

Call SetBypass

Option Compare Database

Public Function SetByPass(rbFlag As Boolean, File_name As String) As Integer
    DoCmd.Hourglass True
    On Error GoTo SetByPass_Error
    Dim db As Database
    Set db = DBEngine(0).OpenDatabase(File_name)
    db.Properties!AllowBypassKey = rbFlag
setByPass_Exit:
    MsgBox "Changed the bypass key to " & rbFlag & " for database " &     File_name, vbInformation, "Skyline Shared"
    db.Close
    Set db = Nothing
    DoCmd.Hourglass False
    Exit Function


SetByPass_Error:
    DoCmd.Hourglass False
    If Err = 3270 Then
        ' allowbypasskey property does not exist
        db.Pro  perties.Append db.CreateProperty("AllowBypassKey", dbBoolean, rbFlag)

        Resume Next
    Else
        ' some other error message
        MsgBox "Unexpected error: " & Error$ & " (" & Err & ")"
        Resume setByPass_Exit
    End If
End Function  

1 个答案:

答案 0 :(得分:1)

上述模块需要在应用程序外部调用 如果您在同一个数据库中,请尝试以下代码

Sub blockBypass()
Dim db As Database, pty As DAO.Property
Set db = CurrentDb
  On Error GoTo Constants_Err 'Set error handler
  db.Properties("Allowbypasskey") = False
  db.Close

Constants_X:
    Exit Sub

Constants_Err:
    If Err = 3270 Then 'Bypass property doesn't exist

        'Add the bypass property to the database
        Set pty = db.CreateProperty("AllowBypassKey", dbBoolean _
            , APP_BYPASS)
        db.Properties.Append pty
        Resume Next

    End If
    MsgBox Err & " : " & Error, vbOKOnly + vbExclamation _
        , "Error loading database settings"

End Sub