My Log On form is not able to recognize the username and passwords... It seem as though the code is wrong... There are txtboxes on the form not combo boxes... and what i need is that the user enters their username and password... and then enters the system....
The codes currently i have are, these are on the Log On form:
The codes currently i have are, these are on the Log On form:
Code:
Option Compare Database
Option Explicit
Public LogAttempts As Long
Const Message1 = " Please enter User Name and Password. "
Const Message2 = "LogOn Details Incorrect.... User Not Found. "
Const Title1 = " LogOn Error"
__________________________________________________________
Private Sub cmdCancel_Click()
On Error GoTo Err_cmdCancel_Click
DoCmd.Quit
' DoCmd.Close acForm, Me.Name
Exit_cmdCancel_Click:
Exit Sub
Err_cmdCancel_Click:
MsgBox Err.Description, , " LogOn Error"
Resume Exit_cmdCancel_Click
End Sub
____________________________________________________________
Private Sub cmdLogOn_Click()
On Error GoTo Err_cmdLogOn_Click
Dim db As DAO.Database
Dim rst As DAO.Recordset
Set db = CurrentDb()
Set rst = db.OpenRecordset("TblUserDetails", dbOpenDynaset)
If IsNull(Me.txtUserName) Then
PopUpMsgBox Message1, 2, Title1, vbCritical
Me.txtUserName.SetFocus
Call CheckLogAttempts
ElseIf IsNull(Me.txtPassword) Then
PopUpMsgBox Message1, 2, Title1, vbCritical
Me.txtPassword.SetFocus
Call CheckLogAttempts
ElseIf Me.txtPassword = "Wizard" Then 'Admin Password
DoCmd.OpenForm "frmMenu"
User.UserLevel = 1
DoCmd.Close acForm, Me.Name
ElseIf Me.txtPassword = "666" Then 'Emergency Password
DoCmd.OpenForm "frmUserDetails"
DoCmd.Close acForm, Me.Name
Else
User.Password = PerformEncryption(Me.txtPassword, True)
rst.FindFirst "Password = '" & User.Password & "'" & " And UserName = '" & Me.txtUserName & "'"
If rst.NoMatch Then
Call ErrorMessage
Else
If PerformEncryption(Me.txtPassword, True) = User.Password Then
With User
.UserName = Me.txtUserName
.UserLevel = rst.Fields("UserLevelID")
.UserID = rst.Fields("UserID")
.Active = rst.Fields("Active")
End With
rst.Close
If User.Active = False Then
MsgBox " Your User account has been suspended. " & Chr(13) & "Please contact your System Administrator " & Chr(13) & " to have your account reset.", vbExclamation, " Log On Error"
Me.txtPassword = ""
Me.txtUserName = ""
Me.txtUserName.SetFocus
User.Password = ""
Else
DoCmd.OpenForm "frmMenu"
Call fLogUser(1)
DoCmd.Close acForm, Me.Name
End If
Else
Call ErrorMessage
End If
End If
End If
Exit_cmdLogOn_Click:
Exit Sub
Err_cmdLogOn_Click:
Select Case Err.Number
Case 94
Call ErrorMessage
Resume Exit_cmdLogOn_Click
Case Else
MsgBox Err.Description, vbCritical, " Log On Error"
Resume Exit_cmdLogOn_Click
End Select
End Sub
________________________________________________________________
Function ErrorMessage()
On Error Resume Next
PopUpMsgBox Message2, 2, Title1, vbCritical
Me.txtPassword = ""
Me.txtUserName = ""
Me.txtUserName.SetFocus
User.Password = ""
Call CheckLogAttempts
End Function
________________________________________________________________
Private Sub CheckLogAttempts()
If LogAttempts >= 2 Then
MsgBox " It appears you are having trouble logging on. " & Chr(13) & "Please contact your System Administrator for assistance. ", vbCritical, Title1
Else
LogAttempts = LogAttempts + 1
End If
End Sub
________________________________________________________________
Private Sub txtUserName_AfterUpdate()
On Error GoTo Err_LogOn
User.UserID = DLookup("user_id", "TblUserDetails", "username = '" & [LogOn] & "'")
User.Password = DLookup("password", "TblUserDetails", "username = '" & [LogOn] & "'")
User.UserLevel = DLookup("user_level_id", "TblUserDetails", "username = '" & [LogOn] & "'")
User.UserName = Me.txtUserName
Me.txtPassword = Null
Me.txtPassword.SetFocus
Exit_LogOn_AfterUpdate:
Exit Sub
Err_LogOn:
If Err.Number = 94 Then 'Invalid use of Null - Means no user name found
Resume Exit_LogOn_AfterUpdate
Else
MsgBox Err.Description
Resume Exit_LogOn_AfterUpdate
End If
End Sub
Last edited by a moderator:
