Securing Access

http://support.microsoft.com/kb/826765: CurrentProject.Properties.Add "AllowBypassKey", False

http://www.databasedev.co.uk/disable_shift_bypass.html

    bAdmin = IIf(GetValue("EXEC GetAdmin") = "Y", True, False)
If Not bAdmin Then
Dim x As Integer
For x = 1 To Application.CommandBars.Count
Application.CommandBars(x).Enabled = False
' Debug.Print Application.CommandBars(x).Name
Next x
'Application.CommandBars("CustomMenuBar").Enabled = True
'Application.CommandBars("CustomMenuBar").Visible = True
Application.CommandBars("CustomMenuBar").Enabled = False
Application.CommandBars("CustomMenuBar").Visible = False
Application.CommandBars("customMenuBar").RowIndex = 1

ChangeProperty "StartUpShowDBWindow", False
ChangeProperty "StartUpShowStatusBar", True
ChangeProperty "AllowBuiltInToolbars", False
ChangeProperty "AllowBreakIntoCode", False
ChangeProperty "AllowToolbarChanges", False
ChangeProperty "AllowSpecialKeys", False
ChangeProperty "AllowBypassKey", False
ChangeProperty "AppTitle", MsgBoxTitle
ChangeProperty "AllowShortcutMenus", False
ChangeProperty "AllowFullMenus", False
Else
Application.CommandBars("Menu Bar").Enabled = True
Application.CommandBars("Menu Bar").Visible = True
ChangeProperty "StartUpShowDBWindow", True
ChangeProperty "StartUpShowStatusBar", True
ChangeProperty "AllowBuiltInToolbars", True
ChangeProperty "AllowBreakIntoCode", True
ChangeProperty "AllowToolbarChanges", True
ChangeProperty "AllowSpecialKeys", True
ChangeProperty "AllowBypassKey", True
ChangeProperty "AppTitle", MsgBoxTitle
ChangeProperty "AllowShortcutMenus", True
ChangeProperty "AllowFullMenus", True

MsgBox "Start Again for security changes to take effect."
End If

Function ChangeProperty(strPropName As String, varPropValue As Variant) As Integer
On Error GoTo ChangeProperty_Error

Dim bFoundProperty As Boolean
Dim x As Integer
bFoundProperty = False

For x = 0 To CurrentProject.Properties.Count - 1
If CurrentProject.Properties(x).Name = strPropName Then
bFoundProperty = True
x = CurrentProject.Properties.Count - 1
End If
Next x

If bFoundProperty Then
CurrentProject.Properties(strPropName).Value = varPropValue
Else
CurrentProject.Properties.Add strPropName, varPropValue
End If
Exit Function

ChangeProperty_Error:
Result = MsgBox("Error " & Err.Number & " '" & Err.Description & "' occured in ChangeProperty." & vbCrLf & "Click OK to retry or Cancel to Quit.", vbCritical + vbOKCancel + vbDefaultButton1)
If Result = vbOK Then
Resume
Else
End
End If
End Function