Login Form Problem with VBA

[data808]

Ok this code seems to make sense. I will try it later tonight and let you know. Thanks a lot robrich22!

[Xipooo]

You have a field on your table called Password right? You can do rs("Password") or rs!Password to access the data from that field.

[data808]

I think I tried that but will try again tonight and let you know. Thanks.

And yes, I have a field in my tblUsers called Password.

[data808]

Sorry I'm going to try this code soon and was wondering if this will replace all my dlookups? Or do I add it on with all what I have currently?

Dim valid As Integer: valid = DCount("Username", "[tblUsers]", "[Username] ='" & txtUsername & "' AND [Password]='" & txtPassword & "'")
If valid = 1 Then
' Success.. Open Form Stuff
Else
MsgBox "Invalid Username or Password"
End If

I should also add that I would like the temp password feature so the user can create their own password. So in order to do that I would have to leave all the string commands too right and add on yours (Dim valid as integer)?

[robrich22]

Sorry I'm going to try this code soon and was wondering if this will replace all my dlookups? Or do I add it on with all what I have currently?

Dim valid As Integer: valid = DCount("Username", "[tblUsers]", "[Username] ='" & txtUsername & "' AND [Password]='" & txtPassword & "'")
If valid = 1 Then
' Success.. Open Form Stuff
Else
MsgBox "Invalid Username or Password"
End If

I should also add that I would like the temp password feature so the user can create their own password. So in order to do that I would have to leave all the string commands too right and add on yours (Dim valid as integer)?

Yes erase everything that you have for the cmdLogin_Click(). Cut and paste the below code into your module to replace that code. This code should work 100%. I will send you another function to change password.. But that will be tomorrow

Private Sub cmdLogin_Click()
    Dim validCredentials As Integer
    Dim userLevel As Variant
On Error GoTo ErrHandler:
    validCredentials = DCount("Username", "[tblUsers]", "[Username] ='" & txtUsername & "' AND [Password]='" & txtPassword & "'")
        
    If validCredentials = 1 Then
        userLevel = Nz(DLookup("SecurityLevel", "[tblUsers]", "[Username]='" & txtUsername & "'"), 0)
        If userLevel = 1 Then
            DoCmd.OpenForm "Admin Main Menu"
        Else
            DoCmd.OpenForm "LSTS Main Menu"
        End If
    Else
        MsgBox "Invalid Username or Password!", vbExclamation, "UNAUTHORIZED!"
        txtUsername = ""
        txtPassword = ""
        txtUsername.SetFocus
    End If
Exit Sub


ErrHandler:
    MsgBox "Unable to Authenticate at this time.  Contact System Administrator for help."
Exit Sub
    
End Sub

[data808]

Hey thanks for the all the work but I'm getting the ErrHandler MsgBox for all scenarios. I tried changing things around but was not able to change the outcome. It always says "Unable to Authenticate at this time. Contact System Administrator for help."

I guess I should also mention that I have a separate table for the user security level. The table is called tblSecurityLevel. In this table is the SecurityID and SecurityLevel field. The ID is the primary key and the SecurityLevel will either read Admin or User. Then in the table called tblUser, there is a field that is called UserSecurity. This field has a relationship to the tblSecurityLevel. I have no idea if this system makes any sense to you. The reason why I have all this is because the first code I used before all of you started helping is the set up I needed to get the first code to work. Let me know if I should get rid of this table. Basically I will only have 2 types of users. One called "Admin" and the other just "User". The admin user will have a different set of forms to do more things in the database such as deleting records and what not. The regular user will have forms for just entering records.

Let me know if this is not clear enough. Again thanks for all the help.

[robrich22]

The code above looks for a field named SecurityLevel in tblUsers. Just add a field to tblUsers
Named SecurityLevel . Assign it number data type. Enter 1 if the user is Admin and 0 for non admin. This code should then work..

[data808]

Ok. So the tblSecurityLevel is useless now. I will delete it after I get this working. I'm also going to try to get it to work so I can call it admin or user instead of just 1 or 0. This way its easier to understand if I have to pass this on to someone else to manage. I'll let you know if I am successful. Thanks so much for all this help robrich22.

[data808]

I just copied and pasted your code again and its doing the same thing. Goes straight to the ErrHandler:

[data808]

Ok I just got rid of the On Error line and also the ErrHandler section of the code and now the debug is pointing to this line:

validCredentials = DCount("Username", "[tblUsers]", "[Username] ='" & txtUsername & "' AND [Password]='" & txtPassword & "'")

So I think something is wrong with this line of code and thats why it was going to the error handler because it would error out on that line then go straight down to the error handler. This is the line in your code that is most foreign to me. I have no idea how to fix it.

[data808]

Ok I found the problem. The table was called tblUser not tblUsers. So now its working. I also tried to add on my TempPass string with the rest of that section in the code and got it to work some what but it was not perfect so I will wait for your assistance on the temp password change part of the code. Thanks for the awesome new code I got. This is what I customized it to:

Private Sub cmdLogin_Click()
Dim validCredentials As Integer
Dim userLevel As Variant
On Error GoTo ErrHandler:
validCredentials = DCount("Username", "[tblUser]", "[Username] ='" & txtUsername & "' AND [Password]='" & txtPassword & "'")

If IsNull(Me.txtUsername) Then
MsgBox "Please Enter Username", vbInformation, "Username Required"
Me.txtUsername.SetFocus
ElseIf IsNull(Me.txtPassword) Then
MsgBox "Please Enter Password", vbInformation, "Password Required"
Me.txtPassword.SetFocus
Else
If validCredentials = 1 Then
userLevel = Nz(DLookup("UserSecurity", "[tblUser]", "[Username]='" & txtUsername & "'"), 0)
If userLevel = "Admin" Then
DoCmd.Close
DoCmd.OpenForm "Admin Main Menu"
Else
DoCmd.Close
DoCmd.OpenForm "LSTS Main Menu"
End If
Else
MsgBox "Invalid Username Or Password!", vbExclamation, "UNAUTHORIZED!"
Me.txtUsername.SetFocus
End If
End If
Exit Sub


ErrHandler:
MsgBox "Unable To Authenticate At This Time. Contact System Administrator For Help."
Exit Sub

End Sub

[robrich22]

Ok here is some new code for you. I tried my best to match everything, so you shouldn't have to change anything. I'v had to seperate some of the logic into seperate functions because it was getting a little big with the new functionality. So you will need to erase what you currently have, and paste all of the code below. It is 2 new functions, and the sub procedure for the click event. You will need to change "frmChangePassword", to whatever the name of your form is.

Private Function VerifyLogin(inUsername As String, inPassword As String) As Boolean
    Dim validCredentials As Integer
    validCredentials = Nz(DCount("Username", "[tblUser]", "[Username] ='" & inUsername & "' AND [Password]='" & inPassword & "'"), 0)
    If validCredentials = 1 Then
        VerifyLogin = True
    Else
        VerifyLogin = False
    End If
End Function


Private Function GetSecurityLevel(inUsername As String) As String
    GetSecurityLevel = Nz(DLookup("UserSecurity", "[tblUser]", "[Username]='" & inUsername & "'"), "")
End Function


Private Sub cmdLogin_Click()


On Error GoTo ErrHandler:
    If IsNull(txtUsername) Or Len(txtUsername) < 1 Then
        MsgBox "Please Enter Username", vbInformation, "Username Required"
        txtUsername.SetFocus
    ElseIf IsNull(txtPassword) Or Len(txtPassword) < 1 Then
        MsgBox "Please Enter Password", vbInformation, "Password Required"
        txtPassword.SetFocus
    Else
        If VerifyLogin(txtUsername, txtPassword) Then
            If (txtPassword = "password") Then
                ' Do change password stuff here.  Make sure to Open Form as acDialog to prevent the rest of the
                ' code from executing until the password has been changed.
                DoCmd.OpenForm "frmChangePassword", acNormal, , , acFormEdit, acDialog
            End If
            If (GetSecurityLevel(txtUsername) = "Admin") Then
                DoCmd.OpenForm "Admin Main Menu"
                DoCmd.Close acForm, Me.Name
            Else
                DoCmd.OpenForm "LSTS Main Menu"
                DoCmd.Close acForm, Me.Name
            End If
        Else
            MsgBox "Invalid Username Or Password!", vbExclamation, "UNAUTHORIZED!"
            txtUsername.SetFocus
        End If
    End If
Exit Sub


ErrHandler:
    MsgBox "Unable To Authenticate At This Time. Contact System Administrator For Help."
Exit Sub


End Sub

[data808]

Hey Robert,

thanks for the code. Before I tested your code out I wanted to see if I could come up with something on my own and believe or not, I actually got the same result as what you suggested with way less additions. The result that I got from my addition to the code actually gets one less problem than yours. Let me explain.

Here is the code that I add on to yours:

Private Sub cmdLogin_Click()
Dim validCredentials As Integer
Dim userLevel As Variant
On Error GoTo ErrHandler:
validCredentials = DCount("Username", "[tblUser]", "[Username] ='" & txtUsername & "' AND [Password]='" & txtPassword & "'")

If IsNull(Me.txtUsername) Then
MsgBox "Please Enter Username", vbInformation, "Username Required"
Me.txtUsername.SetFocus
ElseIf IsNull(Me.txtPassword) Then
MsgBox "Please Enter Password", vbInformation, "Password Required"
Me.txtPassword.SetFocus
Else
If validCredentials = 1 And Me.txtPassword = "password" Then
DoCmd.Close
DoCmd.OpenForm "Change Password", acNormal, , , acFormEdit
Else
If validCredentials = 1 Then
userLevel = Nz(DLookup("UserSecurity", "[tblUser]", "[Username]='" & txtUsername & "'"), 0)
If userLevel = "Admin" Then
DoCmd.Close
DoCmd.OpenForm "Admin Main Menu"
Else
DoCmd.Close
DoCmd.OpenForm "LSTS Main Menu"
End If
Else
MsgBox "Invalid Username Or Password!", vbExclamation, "UNAUTHORIZED!"
Me.txtUsername.SetFocus
End If
End If
End If
Exit Sub


ErrHandler:
MsgBox "Unable To Authenticate At This Time. Contact System Administrator For Help."
Exit Sub

End Sub

Ok so the stuff in red is what I added on and it actually works great except for one thing. When it goes to the Change Password form, it won't pull up the correct record. It will just pull up the first record no matter which user is trying to change the password. I need it to follow the information from the Login form to the Change Password form. In other words, if John is entering his username and password, I need John's information to show up in the Change Password form so that he can make the change to only his record. The Change Password form has all the fields from the tblUser table and all of them are locked except for password so they can make the change and click the submit button to save the new password into the table. I also have navigation buttons disabled, tab disabled, and cycle only current record so they can't go to other users information to change their passwords. Once the user clicks the submit button on the Change Password form it will save the new password to the table then close it and reopen the Login form for the user to try out their new password.

So I tried your code in hopes that it would solve that issue but shockingly I found that your code has that same problem as the one I made changes to and it even errors out to the handler too which mine didn't. So I'm not sure which one I should use at the moment. Do you have any ideas?

Again thank you very much for all the help. You've done more than anyone has ever done for me on this forum already. Usually people on here will throw me hints but you basically wrote the whole thing for me. I'm grateful for that. Thank you Mr. Robert Richardson.

[data808]

Ok I got it to work!

Below in red is what I had to change:

Private Sub cmdLogin_Click()
Dim validCredentials As Integer
Dim userLevel As Variant
Dim ID As Integer
On Error GoTo ErrHandler:
validCredentials = DCount("Username", "[tblUser]", "[Username] ='" & txtUsername & "' AND [Password]='" & txtPassword & "'")

If IsNull(Me.txtUsername) Then
MsgBox "Please Enter Username", vbInformation, "Username Required"
Me.txtUsername.SetFocus
ElseIf IsNull(Me.txtPassword) Then
MsgBox "Please Enter Password", vbInformation, "Password Required"
Me.txtPassword.SetFocus
Else
ID = DLookup("UserID", "tblUser", "Username = '" & Me.txtUsername.Value & "'")
If validCredentials = 1 And Me.txtPassword = "password" Then
DoCmd.Close
MsgBox "Please Change Password", vbInformation, "New Password Required!"
DoCmd.OpenForm "Change Password", , , "[UserID] = " & ID
Else
If validCredentials = 1 Then
userLevel = Nz(DLookup("UserSecurity", "[tblUser]", "[Username]='" & txtUsername & "'"), 0)
If userLevel = "Admin" Then
DoCmd.Close
DoCmd.OpenForm "Admin Main Menu"
Else
DoCmd.Close
DoCmd.OpenForm "LSTS Main Menu"
End If
Else
MsgBox "Invalid Username Or Password!", vbExclamation, "UNAUTHORIZED!"
Me.txtUsername.SetFocus
End If
End If
End If
Exit Sub


ErrHandler:
MsgBox "Unable To Authenticate At This Time. Contact System Administrator For Help."
Exit Sub

End Sub

Wow I can't believe I figured it out. I don't even really know how to write the code but I knew that the first code I started with that I posted from the beginning of this thread was able to pull up the correct record of the user that was trying to log in. So I checked back on that code and figured out which Dim to bring over and it works great now. I already did a lot of testing and its looking good but I'll probably test a bit more and make sure everything is in order. Then if you don't mind, you can direct me into either the program that you made to update the front end, or we can try that logging in log of when the users log in at what time and date I guess? Not sure if thats how it works but if you are too busy, I understand. You already did so much to get me up and running with this I expect nothing more from you. Thanks for all the invaluable information you've given me.

[robrich22]

Awesome job at figuring out the code for yourself. I'd pickup a book on beginning Visual Basic for Applications at Amazon, and read a few pages a night. There are of course plenty of free sites too. Here's my code for recording a login. This is a sub procedure that accepts 2 arguments. Username, and an Integer (1 for successful login, 2 for not success).

This code requires a table exists by the name "App Access Log". With the fields "LoginDate", "LoginTime", "WorkStationUser", "UserName", and "Success"

To use the code, just call the procedure after the user logs in or fails to login, recording 1 for true 0 for false. I hope that makes sense.

Private Sub RecordLogin(inUsername As String, inSuccess As Integer)
    Dim sql As String
On Error GoTo ErrHandler:
    sql = "INSERT INTO [App Access Log] ([LoginDate], [LoginTime],[WorkStationUser],[UserName],[Success])" _
        & "VALUES (#" & Date & "#, #" & Time & "#, '" & Application.currentUser & "', '" & inUsername & "', " & inSuccess & ")"
    DoCmd.RunSQL (sql)
    Exit Sub
ErrHandler:
    MsgBox "Error writing to Database."
    Exit Sub
End Sub