Control Form Access

Assign *Permissions* based on Users Level...

You already have your Main Menu (Switchboard) but now you don't want your Users to get access to all the Forms and/or you may only want to assign certain *permissions* based on their level. Here's a technique that will do just that. You can find another way here. (Please read all the way thru before implementing!)

Private Sub cmdDelete_Click()

If Forms![frmMainMenu]![txtSecurityID] <> 13 And Forms![frmMainMenu]![txtDelete] = False Then
   DoCmd.CancelEvent
MsgBox "Please see ADMIN's " & ConcatRelated("ADMINNames", "qryADMINs", "uSecurityID = " & 13) & " to DELETE records!", vbCritical, "Permissions"
Exit Sub
End If

Dim intResp As Integer

intResp = MsgBox("This will remove the record from your system! Are you sure?", vbYesNo + vbExclamation, "Delete")

If intResp = vbYes Then

   Call LogDeletion(Me.txtOrderID, "frmOrders", "Order " & Me.txtOrderID & " has been successfully deleted!")
   MsgBox "Deleted successfully"
Else
   DoCmd.CancelEvent
End If
End Sub

In your Table where you keep your Users information add whichever fields are missing from your table from the one below. Note, txtDepartmentID is optional and not needed to implement this module. (You can name your fields whatever you like, however, make sure you follow that field name change throughout the rest of the code on this page.)

To capture this information I use a New User form where the User enters their First Name, Last Name and eMail Address and the balance is captured via code. Doing it this way you don't have to pester the User with logging on every time they want to open the database. Initially, their permission is set to Read Only, to change it to Read/Write you will need an ADMIN.

If you don't already have one, set up tblSecurity, as shown below. You only need to enter the three entries shown below. The ones with nothing under sSecurity are not used in this example. Again, if you already have one under a different name you will need to change he code accordingly.

On your Main Menu (or Switchboard) you will need 6 (six) hidden unbound fields named...

Copy and paste the code between Private Sub Form_Load() and End Sub to the On_Load event of your Main Menu (or Switchboard). (Reminder, check the field names to make sure they are reflected below if you are not using the ones assigned above.)

frmNewUser available here.

On a Command Button...

On a Forms On_Current event...

Private Sub Form_Current()
On Error Resume Next

     If Forms![frmMainMenu]![txtSecurityID] = 9 Then
       fncLockUnlockControls Me, True
     Else
       fncLockUnlockControls Me, False
     End If

End Sub

Private Sub Form_Current()
On Error Resume Next

     If Forms![frmMainMenu]![txtSecurityID] <> 13 And Forms![frmMainMenu]![txtOverride] = False Then
       fncLockUnlockControls Me, True
     Else
       fncLockUnlockControls Me, False
     End If

End Sub

You may want to add a Temporary Access button. This button can be used for several purposes, such as, giving a User temporary ADMIN abilities or with some additional code the ability to delete when that is only reserved for ADMIN's.

To do so, add a command button to your Main Menu (or Switchboard) and name it cmdTemporaryAccess. You can put whatever image or caption you want on the button. In the screenshot above it's the command button with the image of a key on it.

Then copy\paste the code between Private Sub cmdTemporaryAccess_Click and End Sub to the On_Click event of the button. (Reminder, check the field names to make sure they are reflected below if you are not using the ones assigned above.)

Create a Module, mine is named modUtilities, and copy/paste the IsDeveloper() and ChangeProperty() code shown below into the Module. Do NOT paste behind the Form these two Functions must be a separate Module.

The difficult I do immediately, the impossible takes a little bit longer.

Forms

Tips (Main)

Home

Let your Client customize the form labels

Linking Subforms to an Unbound Control(s) on the Main (Parent) Form

Customize your Main Menu or Switchboard

Auto-Add new child records when adding a new record on the Main (Parent) Form

Simple Bar Chart using Shapes

Simulate a Drop Down box (not a Combo Box) as seen on Web Pages

Implement a Log-On form to control what the User sees

Make Controls resize with a Form

Switch Windows

New User Form

Add *Favorites* to a Continuous Form

Custom Record Selectors

Searching Records

Drill Down (for Continuous Forms)

Highlight Required Controls (End-User Defined)

txtSecurityID

txtOverride

txtUserID

txtDelete

txtDepartmentID *Optional, not used in this example

txtPassword

Private Sub Form_Load()
On Error Resume Next
 
Dim rst As DAO.Recordset
Dim db As DAO.Database
Dim myQuery As String
 
myQuery = "SELECT * FROM tblUsers WHERE uNetworkID = '" & Environ("UserName") & "'"
 
Set db = CurrentDb()
Set rst = db.OpenRecordset(myQuery, dbOpenDynaset, dbSeeChanges)
 
     If Not rst.BOF And Not rst.EOF Then
       rst.Edit
       rst.Fields("uLogonCount") = rst.Fields("uLogonCount") + 1
       rst.Fields("uLastLogon") = Now()
       rst.Update
        Me.txtSecurityID = rst.Fields("uSecurityID")
        Me.txtOverride = rst.Fields("uSpecialPermissions")
        Me.txtUserID = rst.Fields("uUserID")
        Me.txtDelete = rst.Fields("uDelete")
        Me.txtPassword = rst.Fields("uPassword")
       DoEvents
     Else
       DoCmd.OpenForm "frmNewUser", acNormal, , , , acWindowNormal
       Me.Dirty = False
       Me.Visible = False
 
       Do Until Me.Tag = "Continue"
         DoEvents
       Loop
     End If
 
Set rst = Nothing
db.Close
Set db = Nothing
 
          If IsDeveloper Then
             ChangeProperty "AllowBypassKey", dbBoolean, True
          Else
             ChangeProperty "AllowBypassKey", dbBoolean, False
          End If
 
Form_Load_Exit:
Exit Sub
End Sub

Function IsDeveloper() As Boolean
 
     Dim UserName As String
     IsDeveloper = False
     UserName = VBA.Environ("Username")
 
     Select Case UserName
      Case "Your NetworkID goes here"
        IsDeveloper = True
      Case Else
        IsDeveloper = False
     End Select
 
End Function

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 
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
       Resume Change_Bye
   End If
 
End Function

Private Sub cmdTemporaryAccess_Click()
On Error Resume Next
 
Dim pwd As String
 
pwd = InputBox("Please enter password", "ADMIN Access")
 
If pwd = DLookup("uPassword", "tblUsers", "uNetworkID = '" & Environ("UserName") & "'") Then
Me.txtSecurityID = 13
MsgBox ("You can now enter the Administrative area!")
Else
MsgBox ("Incorrect password")
End If
End Sub