Tutorial -- An Access menu / permissions system

SydneyGeek

MrExcel MVP
Joined
Aug 5, 2003
Messages
12,251
This is a post to put in one place an approach I use for giving different access levels to different groups of users in your Access databases. It also provides a flexible menu that adjusts to the user's permissions. It does not require the users to log in: their Windows login name is captured when they open the database. It is easy to restrict the forms. reports etc that they can use, simply by maintaining two tables; one for access levels, and one for menu items.
Parts of this have appeared on this Board before: parts are new. I hope you find it useful.

The login / menu form

You will need:

1. A table called tblStaff, with at least the fields Login and Permissions. Both are Text fields.
(a) In Login, enter the Windows login name of each user who will have ability to add or change data. Those whose names do not appear here will have read-only access to the database.
(b) In Permissions, give them values Edit or Admin

2. A form that opens as your main menu. In this example the form is frmMenu. On this form you need 2 hidden textboxes called txtUser and txtLevel.
In the Form's Load event you will need this code:

If you don't know how to do this, here's how:
Go to the form's Properties.
Click the Events tab.
Double-click the blank Load row, so you see Event Procedure.
Click the Builder (...) button to go to the code window.
Paste this code in, replacing this stuff:
Code:
Private Sub Form_Load

End Sub
With the code you copied.

Here it is:
Code:
Private Sub Form_Load()
    Dim sPermit As String
    Dim iAccess As Integer
    Dim Ctl As Access.Control
    Me.txtUser = Environ("username")
    If IsNothing(Me.txtUser) Then
        sPermit = "ReadOnly"
    Else
        sPermit = GetPermission(Me.txtUser)
    End If
    Select Case sPermit
        Case "Edit"
            iAccess = 2
        Case "Admin"
            iAccess = 3
        Case Else
            iAccess = 1
    End Select
    Me.txtLevel = iAccess
End Sub

Private Function GetPermission(sUser As String)
    If (IsNothing(DLookup("Permissions", "tblStaff", "Login='" & Forms!frmmenu!txtUser & "'"))) Then
        GetPermission = "ReadOnly"
    Else
        GetPermission = DLookup("Permissions", "tblStaff", "Login='" & Forms!frmmenu!txtUser & "'")
    End If
End Function

You give the lowest number to the lowest level of access. So, 1 is for general users whose names do not appear in the login table. They will have read-only access to forms. 2 is for those with more permissions. They will be able to add and edit data. 3 is for those with Admin privileges. They will be able to change user settings and make other behind-the-scenes modifications.

3. On each form that opens you need this in the Form_Load event:

Code:
If forms!frmMenu!txtLevel = 1 Then
   Me.AllowEdits = False
Else
   Me.AllowEdits = True
End If

A listbox to provide the menu items

This listbox will give the users the menu choices they need to navigate through the database. It is based on a table called MenuItems, with these fields:

Code:
Item        Text     The descriptive text that appears in the listbox
Level       Number   1, 2 or 3
Form        Text     The name of the form or report to open
ObjectType  Text     Form or Report
SortOrder   Number   Adjust to suit. List is sorted in ascending order.

The listbox itself is called lstMenu. It lives on the menu form that you created in the first part of this tutorial. It has these properties:

Code:
Row Source Type      Table/Query
Row Source           SELECT MenuItems.Item, MenuItems.Form, MenuItems.ObjectType FROM MenuItems WHERE (((MenuItems.Level)<=Forms!frmmenu!txtLevel)) ORDER BY MenuItems.SortOrder
Column Count         5
Column Widths        3;0;0;0;0
Bound Column         1

Populate the table and build the listbox. Check to see that it works OK. You can do that by giving yourself different levels of access in the login table, closing and re-opening the menu form and checking that the menu adjusts. Now, to make it launch the forms and reports, you will need this code in the Click event of the listbox:

Code:
    Dim sForm As String, sType As String
    sForm = Me.lstMenu.Column(1)
    sType = Me.lstMenu.Column(2)
    Select Case sType
        Case "Form"
            DoCmd.OpenForm sForm
        Case "Report"
            DoCmd.OpenReport sForm, acViewPreview
    End Select


A general function to test for "nothing"
This function below needs to go in a general code module. You will find yourself using it for much more than just the login form.

Code:
Public Function IsNothing(ByVal varValueToTest) As Integer
'-----------------------------------------------------------
' Does a "nothing" test based on data type.
'   Null = nothing
'   Empty = nothing
'   Number = 0 is nothing
'   String = "" is nothing
'   Date/Time is never nothing
' Inputs: A value to test for logical "nothing"
' Outputs: True = value passed is a logical "nothing", False = it ain't
' Created By: John L viescas 01/31/95
' Last Revised: John L viescas 01/31/95
'-----------------------------------------------------------
Dim intSuccess As Integer

    On Error GoTo IsNothing_Err
    IsNothing = True

    Select Case VarType(varValueToTest)
        Case 0      ' Empty
            GoTo IsNothing_Exit
        Case 1      ' Null
            GoTo IsNothing_Exit
        Case 2, 3, 4, 5, 6  ' Integer, Long, Single, Double, Currency
            If varValueToTest <> 0 Then IsNothing = False
        Case 7      ' Date / Time
            IsNothing = False
        Case 8      ' String
            If (Len(varValueToTest) <> 0 And varValueToTest <> " ") Then IsNothing = False
    End Select


IsNothing_Exit:
    On Error GoTo 0
    Exit Function

IsNothing_Err:
    IsNothing = True
    Resume IsNothing_Exit

End Function

Denis
 
I got it ... earlier on I had the Me.lstMenu.Requery in Form_Load and I had problems so I took that out and it worked... but then it stopped working and the problem was more consistent. I remembered reading the earlier post about Me.lstMenu.Requery so I put it back in and it seems to be working. Thanks again.
 
Upvote 0

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
Wow this is a great tutorial. Thank you so much! Can I do this with a database in which we have 12 tables? I need for my staff to be able to look at the data but make no edits to it. Does this system work with tables?

Thanks!
 
Upvote 0
Yes it does. In the segments where you add a region and populate it, you're directly using a table. Where you retrieve data by region, you are creating a filter to effectively run a query on a table.

To prevent people editing the database, just leave out the parts that write back to the database (and let them know that if they change anything in teh spreadsheet, it won't affect the database).

I'd recommend a new sheet for each table or query that you want to use.

Denis
 
Upvote 0
OK, thank you. I am going to attempt to set this up tomorrow. I'm sure I'll be back with more questions. :biggrin:
 
Upvote 0
Hmmm should have read the topic first. I have 2 tutorials, and thought you were referring to the other one (Access and Excel)
it doesn't change the fact that you can use this for tables, but generally we use filters because that reduces network traffic and makes the system more usable.
To prevent edits, you open the form read-only based on their permission level. For example, an Admin can edit, but lower level users can only read.

Denis
 
Upvote 0
Hello,

I am trying to incorporate this permissions system in Access 2010, but I am getting the following error message: Compile error: Sub or Function not defined. This is the first portion of the code, in the Load event of the frm_Main_Menu. the line Private Sub Form_Load() is highlighted and IsNothing is highlighted in the first If statement.

Your assistance is most appreciated!

Here is my code:

Private Sub Form_Load()
Dim sPermit As String
Dim iAccess As Integer
Dim Ctl As Access.Control
Me.txtUser = Environ("username")
If IsNothing(Me.txtUser) Then
sPermit = "ReadOnly"
Else
sPermit = GetPermission(Me.txtUser)
End If
Select Case sPermit
Case "Edit"
iAccess = 2
Case "Admin"
iAccess = 3
Case Else
iAccess = 1
End Select
Me.txtLevel = iAccess
DoCmd.Maximize
End Sub
Private Function GetPermission(sUser As String)
If (IsNothing(DLookup("Permissions", "tblStaff", "Login='" & Forms!frm_Main_Menu!txtUser & "'"))) Then
GetPermission = "ReadOnly"
Else
GetPermission = DLookup("Permissions", "tblStaff", "Login='" & Forms!frm_Main_Menu!txtUser & "'")
End If
End Function
 
Upvote 0
Hi, and welcome to the Board.

That sort of error often happens if something is missing. I'd suggest that you put a break-point on the first line of that sub, then launch the for and go into Debug.
Press the {F8} key and watch how the code runs, one line at a time. Check to see where you are (you may not be in the starting sub when the error occurs); that will give clues to what the problem might be. I assume that you have tblStaff, and all of the controls on the menu form have the expected names?

Try it out, and let us know where the error happened, then it should be easier to give more detailed help.

Denis
 
Upvote 0
Hi, and Thank you!
I went through your steps again and saw that later in this thread, someone else had the same issue, and your response was to also include the code testing for IsNothing. Once I added this, everything works great!

I consider myself a beginner in VBA, but trying to learn. Forums are great, and I will be forever indebted to individuals such as yourself for being willing to help us Newbies!

Thank you so much!
Vicki
 
Upvote 0
You're welcome, and I'm glad that I could point you in the right direction.

As you can see from the first post this thread has been up for several years, so I don't always remember what answers I gave to earlier questions ;-)

Denis
 
Upvote 0

Forum statistics

Threads
1,223,911
Messages
6,175,323
Members
452,635
Latest member
laura12345

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top