Controlling User Access

Sub SetBypassProperty()
'locks the database and does not allow shift key 
Const DB_Boolean As Long = 1
    ChangeProperty "AllowBypassKey", DB_Boolean, False
    MsgBox "False"
End Sub
'Unlocks Database and allows use of shift key
Sub UnSetBypass()
Const DB_Boolean As Long = 1
    ChangeProperty "AllowBypassKey", DB_Boolean, True
    MsgBox "True"
End Sub
Function ChangeProperty(strPropName As String, varPropType As Variant, varPropValue As Variant) As Integer
    Dim dbs As Object, prp As Variant
    Const conPropNotFoundError = 3270

    Set dbs = CurrentDb
    On Error GoTo Change_Err
    dbs.Properties(strPropName) = varPropValue
    ChangeProperty = True
    MsgBox "Goodbye"
    
Change_Bye:
    Exit Function

Change_Err:
    If Err = conPropNotFoundError Then    ' Property not found.
        Set prp = dbs.CreateProperty(strPropName, _
            varPropType, varPropValue)
        dbs.Properties.Append prp
        Resume Next
    Else
        ' Unknown error.
        ChangeProperty = False
        MsgBox "Come back soon!", vbCritical, "DB says"
    
        Resume Change_Bye
    End If
End Function