Thread: Custom Access Login

Download attached Sample,

This is for use with FE BE database, Make Sure that the CurrentUser Table is on the FE

Employee Table

Employee ID Number - AutoNumber
Employee Name
Employee Password Input Mask - Password
Employee Access Level
Forms (Or Group of forms) Yes/No

CurrentUser Table
CurrUser - Number - Relational to Employee ID Number - AutoNumber

Delete Query
To Clear current user on new session

Login Form - FrmLogon

Switchboard

Admin - Admin Form (Add Users and change access right, passwords)

Login Script,

Code:

'Check to see if data is entered into the UserName combo box

    If IsNull(Me.cboEmployee) Or Me.cboEmployee = "" Then
            MsgBox "You must enter a User Name.", vbOKOnly, "Required Data"
            Me.cboEmployee.SetFocus
        Exit Sub
    End If

'Check to see if data is entered into the password box

    If IsNull(Me.txtPassword) Or Me.txtPassword = "" Then
            MsgBox "You must enter a Password.", vbOKOnly, "Required Data"
            Me.txtPassword.SetFocus
        Exit Sub
    End If

'Check value of password in Employees to see if this matches value chosen in combo box

    If Me.txtPassword.Value = DLookup("strEmpPassword", "Employees", "[lngEmpID]=" & Me.cboEmployee.Value) Then

    lngMyEmpID = Me.cboEmployee.Value
        
    Dim stDocName As String
    Dim SQL As String
    DoCmd.SetWarnings (warningsoff)
    stDocName = "Qry_01_Login_Delete_Table"
    DoCmd.OpenQuery stDocName, acNormal, acEdit
   
    CurUser = Me.cboEmployee.Value
    SQL = "Insert InTo [CurrentUser] (CurrUser)" _
    & " Values ( '" & CurUser & "')"
              
    DoCmd.RunSQL SQL
    DoCmd.SetWarnings (WarningsOn)
    

'Close logon form and open switchboard screen
        
        DoCmd.Close acForm, "FrmLogon", acSaveNo
        DoCmd.OpenForm "Switchboard"
        

        Else
        MsgBox "Password Invalid.  Please Try Again", vbOKOnly, "Invalid Entry!"
        Me.txtPassword.SetFocus
        Me.txtPassword = Null
    
    End If
    

End Sub

Login Failure

Code:

'If User Enters incorrect password 3 times database will shutdown
    
    intLogonAttempts = intLogonAttempts + 1
    If intLogonAttempts > 3 Then
        MsgBox "You do not have access to this database.  Please contact your system administrator.", vbCritical, "Restricted Access!"
        Application.Quit
    End If
    
End Sub

Script for Open Form Buttons on Switchboard, based on user privileges

Code:

Private Sub Command0_Click()
Dim strSQL As String

strSQL = DLookup("strAccess", "Qry_CurrentUser")

 If strSQL = "Admin" Then
 
    Dim stDocName As String
    Dim stLinkCriteria As String

    stDocName = "Admin"
    DoCmd.OpenForm stDocName, , , stLinkCriteria

        Else
            MsgBox ("Sorry, you do not have access to this information")
  
            Exit Sub
        End If
End Sub

Code:

Private Sub Command1_Click()
Dim strSQL As String

strSQL = DLookup("F1", "Qry_CurrentUser")

 If strSQL = -1 Then
 
 
    Dim stDocName As String
    Dim stLinkCriteria As String

    stDocName = "Form1"
    DoCmd.OpenForm stDocName, , , stLinkCriteria


        Else
            MsgBox ("Sorry, you do not have access to this information")
  
            Exit Sub
        End If
End Sub

This can also be used to track table changes based on current user. If you have any question, please ask. You may decide to Disable the Shift key to secure the database window.

lngMyEmpID is defined as:

Code:

lngMyEmpID = Me.cboEmployee.Value

This is located in the routine: cmdLogin_Click of frmLogin. However, I also get the same error message and I don't see any object named Note.

That's weird.... it works flawlessly on my computer.....

Just re-downloaded and checked again - no problems on my end

It works, but when you try to compile it you get the error.

Hi, when i designed this i used Me.Note.SelLength = 0 to set the focus to the terms and conditons of access. I should have deleted it from this sample.

Looks like he left a subroutine in there from something else.

I removed it, and the database compiled without error.

Here is the appended version of AOG's database.