I have this structure and im trying to use this code but i get an error
Code: Select all
Private Sub cmdLogin_Click()
Dim userLevel As Integer
Dim userID As Variant
Dim userPassword As String
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim rs As DAO.Recordset
On Error GoTo ErrorHandler
' Validate user input
If IsNull(Me.cboUserName) Then
MsgBox "Please select a user name.", vbExclamation, "User Name Missing"
Me.cboUserName.SetFocus
Exit Sub
ElseIf IsNull(Me.txtPassword) Then
MsgBox "Please enter your password.", vbExclamation, "Password Missing"
Me.txtPassword.SetFocus
Exit Sub
End If
' Get user ID and password
userID = Me.cboUserName.Value
userPassword = Me.txtPassword.Value
' Debug statements to check parameter values
' Debug.Print "UserID: " & userID
' Debug.Print "Password: " & userPassword
' Open a recordset to check credentials
Set db = CurrentDb
Set qdf = db.CreateQueryDef("")
' Define SQL command with parameters
qdf.SQL = "SELECT UserID, UserName, SecurityLevel FROM tblUsers INNER JOIN tblSecurityLevel ON tblUsers.UserID = tblSecurityLevel.SecurityID WHERE UserID = @UserID AND [Password] = @Password;"
qdf.Parameters("@UserID") = userID
qdf.Parameters("@Password") = userPassword
' Execute query
Set rs = qdf.OpenRecordset(dbOpenSnapshot, dbReadOnly)
' Check if user exists and password matches
If Not rs.EOF Then
' User authenticated successfully
userLevel = rs!SecurityLevel
If userLevel = 1 Then
' Open Home Form
DoCmd.OpenForm "frmDataEntry", acNormal
ElseIf userLevel = 2 Then
' Open Change Password Form
DoCmd.OpenForm "frmChangePassword", acNormal
End If
' Close the login form
DoCmd.Close acForm, Me.Name
Else
' Invalid credentials
MsgBox "Incorrect user name or password. Please try again.", vbExclamation, "Login Failed"
Me.cboUserName.SetFocus
Me.cboUserName.Dropdown
End If
' Clean up
rs.Close
Set rs = Nothing
Set qdf = Nothing
Set db = Nothing
Exit Sub
ErrorHandler:
MsgBox "Error: " & Err.Number & " - " & Err.Description, vbCritical, "Error"
' Clean up
If Not rs Is Nothing Then
rs.Close
Set rs = Nothing
End If
If Not qdf Is Nothing Then
Set qdf = Nothing
End If
If Not db Is Nothing Then
Set db = Nothing
End If
End Sub