Enable AllowBypassKey based off password - ms-access

Question

I have a created a database that has the AllowBypassKey shift key disabled. What I am trying to do is have a hidden box that when double clicked on pops up a box where the user must enter the password and then the AllowBypassKey is enabled. I have added the code I have written so far but I am getting a "Sub or Function not defined" for the SetProperties portion. I have shown the disable AllowBypassKey code as well.
Disable Bypass code:
Function ap_DisableShift()
On Error GoTo errDisableShift
Dim db As DAO.Database
Dim prop As DAO.Property
Const conPropNotFound = 3270
Set db = CurrentDb()
db.Properties("AllowByPassKey") = False
Exit Function
errDisableShift:
If Err = conPropNotFound Then
Set prop = db.CreateProperty("AllowByPassKey", _
dbBoolean, False)
db.Properties.Append prop
Resume Next
Else
MsgBox "Function 'ap_DisableShift' did not complete successfully."
Exit Function
End If
End Function
Double-Click Code (Error popping up!)
Private Sub Secret_DblClick(Cancel As Integer)
On Error GoTo Err_bDisableBypassKey_Click
Dim strInput As String
Dim strMsg As String
Beep
strMsg = "Do you want to enable the Bypass Key"
strInput = InputBox(Prompt:=strMsg, Title:="Disable Bypass Key Password")
If strInput = "PASSWORD" Then
SetProperties "AllowBypassKey", dbBoolean, True
Beep
MsgBox "The Bypass Key has been enabled."
Else
Beep
SetProperties "AllowBypassKey", dbBoolean, False
MsgBox "Incorrect ''AllowBypassKey'' Password!"
Exit Sub
End If
Exit_bDisableBypassKey_Click:
Exit Sub
Err_bDisableBypassKey_Click:
MsgBox "bDisableBypassKey_Click", Err.Number, Err.Description
Resume Exit_bDisableBypassKey_Click
End Sub

Answer 1

You can use Allen Browne's SetPropertyDAO and HasProperty functions to manage the AllowBypassKey setting. (Source for those functions is here; and also included at the bottom of this answer.)
Then to normally disable AllowBypassKey for all users at database start, create this function and call it from the RunCode action of your database's AutoExec macro:
Public Function StartUp()
SetPropertyDAO CurrentDb, "AllowBypassKey", dbBoolean, False
End Function
To allow your privileged user(s) to override that setting (IOW to enable AllowBypassKey), use this tested version of your Secret_DblClick procedure:
Private Sub Secret_DblClick(Cancel As Integer)
Dim strInput As String
Dim strMsg As String
On Error GoTo Err_bDisableBypassKey_Click
Beep
strMsg = "Do you want to enable the Bypass Key"
strInput = InputBox(Prompt:=strMsg, Title:="Disable Bypass Key Password")
If strInput = "PASSWORD" Then
SetPropertyDAO CurrentDb, "AllowBypassKey", dbBoolean, True
Beep
MsgBox "The Bypass Key has been enabled."
Else
Beep
SetPropertyDAO CurrentDb, "AllowBypassKey", dbBoolean, False
MsgBox "Incorrect 'AllowBypassKey' Password!"
End If
Exit_bDisableBypassKey_Click:
Exit Sub
Err_bDisableBypassKey_Click:
MsgBox "bDisableBypassKey_Click", Err.Number, Err.Description
Resume Exit_bDisableBypassKey_Click
End Sub
Function SetPropertyDAO(obj As Object, strPropertyName As String, intType As Integer, _
varValue As Variant, Optional strErrMsg As String) As Boolean
On Error GoTo ErrHandler
'Purpose: Set a property for an object, creating if necessary.
'Arguments: obj = the object whose property should be set.
' strPropertyName = the name of the property to set.
' intType = the type of property (needed for creating)
' varValue = the value to set this property to.
' strErrMsg = string to append any error message to.
If HasProperty(obj, strPropertyName) Then
obj.Properties(strPropertyName) = varValue
Else
obj.Properties.Append obj.CreateProperty(strPropertyName, intType, varValue)
End If
SetPropertyDAO = True
ExitHandler:
Exit Function
ErrHandler:
strErrMsg = strErrMsg & obj.Name & "." & strPropertyName & " not set to " & _
varValue & ". Error " & Err.Number & " - " & Err.Description & vbCrLf
Resume ExitHandler
End Function
Public Function HasProperty(obj As Object, strPropName As String) As Boolean
'Purpose: Return true if the object has the property.
Dim varDummy As Variant
On Error Resume Next
varDummy = obj.Properties(strPropName)
HasProperty = (Err.Number = 0)
End Function