Option Compare Database
Option Explicit
Private Sub BtnLoginOK_Click()
On Error GoTo Err_Handler
Dim vpwd As String
Static Attempts As Integer 'for info Static / Dim do the same thing
Dim SLevels As String
'Check if username is entered.
If Nz(Me.cboUsername, "") = "" Then
MsgBox "Username is required", vbOKOnly, "Invalid Entry!"
Me.cboUsername.SetFocus
Exit Sub
End If
'Check if Password is entered.
If Nz(Me.txtPassword, "") = "" Then
MsgBox "Password is required", vbOKOnly, "Invalid Entry!"
Me.txtPassword.SetFocus
Exit Sub
End If
'Check case sensitivity of entered username and password is correct 'z123VF&@'.
If strLoginID <> "" Then
'CR - replaced LoginID with strLoginID & moved Debug.Print to separate line
vpwd = Nz(DLookup("strPassword", "tblUserSecurity", "LoginID='" & strLoginID & "'"), "")
'Debug.Print vpwd
If StrComp(Me.txtPassword.Value, vpwd, vbBinaryCompare) <> 0 Then
MsgBox "Invalid Password.", vbOKOnly, "Invalid Entry"
Exit Sub
End If
End If
'Check if user's 3 attempts are wrong then close the database with message.
If Me.txtPassword.Value = DLookup("[strPassword]", "tblUserSecurity", "[LoginID]='" & Me.cboUsername.Value & "'") Then
'MsgBox "Welcome to Employee Management System"
'Call LoginSessions functions to record the Logged on user activity
TempVars("LoginID").Value = Me.cboUsername.Value
Dim lngEmp As Integer
Dim strComputer As String
Dim myLogin As String
lngEmp = DLookup("EmpID", "tblUserSecurity", "LoginID='" & myLogin & "'")
strComputer = Environ("ComputerName")
myLogin = TempVars("LoginID").Value
CurrentDb.Execute "INSERT INTO tblLoginSessions(EmpID, ComputerName, ComputerIP) VALUES(" & lngEmp & ",'" & strComputer & "','" & GetMyPublicIP(), "' )"
CurrentDb.Execute "UPDATE tblUserSecurity Set Active = True WHERE EmpID = " & lngEmp
Else
Attempts = Attempts + 1
Select Case Attempts
Case 1
MsgBox "Username or password is incorrect!" & vbCrLf & _
"Please try again", vbCritical, "Warning"
Me.cboUsername.SetFocus
Exit Sub
Case 2
MsgBox "You have entered an incorrect username or password twice" & vbCrLf & _
"You have one more chance to do this correctly", vbCritical, "Warning"
Me.cboUsername.SetFocus
Exit Sub
Case 3
MsgBox "You do not have access to EMS Database, Please contact system Administrator", vbOKOnly, "Invalid Entry!"
Application.Quit
End Select
End If
SLevels = Nz(DLookup("SecurityLevel", "tblUserSecurity", "[LoginID] = '" & Me.cboUsername & "'"), "")
'Update the tblLoginSessions to users
Select Case SLevels
Case "Admin"
'Full control all buttons & options ON (on frmDataEntry_Navigation i have enabled button based on "Admin").
DoCmd.OpenForm "frmAdminNavigation"
Forms![frmAdminNavigation]![txtAccessLevel] = Me.txtSecurityLevel
Forms![frmAdminNavigation]![txtLoginID] = Me.cboUsername
' Exit Sub 'CR - removed
Case "Employee"
'Go to Data entry menu with User Access Level (by default button is disabled on frmDataEntry_Navigation).
DoCmd.OpenForm "frmEmployeeNavigation"
Forms![frmEmployeeNavigation]![txtEmpNavLoginID] = Me.cboUsername
' Exit Sub 'CR - removed
Case "User"
'Go to Individual record access form.
DoCmd.OpenForm "frmUserNavigation"
Forms![frmUserNavigation]![txtEmpID] = Me.EmpIDtxt
Forms![frmUserNavigation]![txtLoginEmp] = Me.cboUsername
' Exit Sub 'CR - removed
End Select
'close this form!
'DoCmd.Close acForm, Me.Name
Me.Visible = False
Exit_Handler:
Exit Sub
Err_Handler:
MsgBox "Error " & Err.Number & " " & Err.Description & " iun cmdLogin_Click procedure"
Resume Exit_Handler
End Sub