Is a good procedure found arround to lock an app. - Eleftheriadis Constantine web site

Private Sub bDisableBypassKey_Click()
   On Error GoTo Err_bDisableBypassKey_Click
   'This ensures the user is the programmer needing to disable the Bypass Key
   Dim strInput As String
   Dim strMsg As String
   Beep
   strMsg = "Do you want to enable the Bypass Key?" & vbCrLf & vbLf & _
            "Please key the programmer's password to enable the Bypass Key."
   strInput = InputBox(Prompt:=strMsg, title:="Disable Bypass Key Password")
   If strInput = "12345!@#$%" Then                                       ' Password example MUST be changed as want
       SetProperties "AllowBypassKey", dbBoolean, True
       Beep
       MsgBox "The Bypass Key has been enabled." & vbCrLf & vbLf & _
              "The Shift key will allow the users to bypass the startup" & _
              "options the next time the database is opened.", _
              vbInformation, "Set Startup Properties"
' / down /            UnLockOptions            ' Call from basLockDb > By enabling this option, some features of db are going to be locked
   DoCmd.ShowToolbar "Ribbon", acToolbarYes        ' UnHide the ribbon
   DoCmd.SelectObject acTable, , True
   Else
       Beep
       SetProperties "AllowBypassKey", dbBoolean, False
       MsgBox "Incorrect ''AllowBypassKey'' Password!" & vbCrLf & vbLf & _
              "The Bypass Key was disabled." & vbCrLf & vbLf & _
              "The Shift key will NOT allow the users to bypass the" & _
              "startup options the next time the database is opened.", _
              vbCritical, "Invalid Password"
' / Down /    LockOptions            ' Call from basLockDb > By enabling this option, some features of db are going to be locked
   DoCmd.NavigateTo "acNavigationCategoryObjectType"
   DoCmd.RunCommand acCmdWindowHide
   DoCmd.ShowToolbar "Ribbon", acToolbarNo        ' Hide the ribbon
   'And this will bring it back again
   'DoCmd.SelectObject acTable, , False
              
       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
' -------------------------------     1st function
Public Function SetProperties(strPropName As String, _
varPropType As Variant, varPropValue As Variant) As Integer
   On Error GoTo Err_SetProperties
   Dim db As DAO.Database, prp As DAO.Property
   Set db = CurrentDb
   db.Properties(strPropName) = varPropValue
   SetProperties = True
   Set db = Nothing
Exit_SetProperties:
   Exit Function
Err_SetProperties:
   If Err = 3270 Then    'Property not found
       Set prp = db.CreateProperty(strPropName, varPropType, varPropValue)
       db.Properties.Append prp
       Resume Next
   Else
       SetProperties = False
       MsgBox "SetProperties", Err.Number, Err.Description
       Resume Exit_SetProperties
   End If
End Function
' -------------------------------------    2nd function put it directly under ShiftBypass cmd
Function UnLockOptions()
On Error GoTo Err_DisableStdOption
    Rem show / hide ribbon
       'DoCmd.ShowToolbar "Ribbon", acToolbarNo         ' Hide the ribbon
       DoCmd.ShowToolbar "Ribbon", acToolbarYes        ' UnHide the ribbon
'This should hide the navigation PANE OK
   'DoCmd.NavigateTo "acNavigationCategoryObjectType"
   'DoCmd.RunCommand acCmdWindowHide
   'And this will bring it back again
   DoCmd.SelectObject acTable, , True
'-------------------------------------------------------
Exit_DisableStdOption:
Exit Function

Download the PDF