Login Screen Message Box Showing When a User Has Permissions

[Orange56]

I am currently building a database in which one of the requirements is to pull the user's Windows login name and set permissions for the users (based upon the user's permissions will open their corresponding form). Essentially, this will alleviate the users having to login into both Windows and MS Access through a login screen. I was able to successfully grab the users Windows Login name and permissions within a back end table. The problem that I am having is that when a user does have permissions to the database the message box stating "You do not have access to this database" continues to show. Also, I am not sure if I am correctly using rs.FindFirst "UserName = '" & EmployeeType_ID & "'". As the UserName is the users Windows login name and EmployeeType_ID is a text field which the admin would either place a 1-4 to set the user permission (UserName and EmployeeType_ID are within a table).

Any help would be greatly appreciated!

Private Sub Form_Load()
    
    Debug.Print Environ("UserName")
    Debug.Print Environ$("ComputerName")
    
    Dim strVar As String
    Dim i As Long
    For i = 1 To 255
        strVar = Environ$(i)
        If LenB(strVar) = 0& Then Exit For
        Debug.Print strVar
    Next

Dim rs As Recordset
    
    Set rs = CurrentDb.OpenRecordset("tblUser", dbOpenSnapshot, dbReadOnly)
    
    rs.FindFirst "UserName = '" & EmployeeType_ID & "'"
    
    If rs.NoMatch = True Then
        MsgBox "You do not have access to this database.", vbInformation, "Access"
        Access.Quit
    End If
    
    If rs!EmployeeType_ID = 4 Then
    
        Dim prop As Property
        On Error GoTo SetProperty
        Set prop = CurrentDb.CreateProperty("AllowBypassKey", dbBoolean, False)
        
        CurrentDb.Properties.Append prop

SetProperty:
        If MsgBox("Would you like to turn on the bypass key?", vbYesNo, "Allow Bypass") = vbYes Then
            CurrentDb.Properties("AllowBypassKey") = True
        Else
            CurrentDb.Properties("AllowBypassKey") = False
        End If
        
            DoCmd.OpenForm "frmManager"
            DoCmd.Close acForm, "frmLogin", acSaveNo
    End If

    If rs!EmployeeType_ID = 3 Then
        DoCmd.OpenForm "frmAssisstant_Manager"
        DoCmd.Close acForm, "frmLogin", acSaveNo
    End If
    
    If rs!EmployeeType_ID = 2 Then
        DoCmd.OpenForm "frmLead"
        DoCmd.Close acForm, "frmLogin", acSaveNo
    End If
    
    If rs!EmployeeType_ID = 1 Then
        DoCmd.OpenForm "frmGeneral_User"
        DoCmd.Close acForm, "frmLogin", acSaveNo
    End If
End Sub

 

[pbaldy]

I think you want:

rs.FindFirst "UserName = '" & Environ("UserName") & "'"

I personally would open the recordset filtered rather than use FindFirst, but a user table is probably small enough to make it irrelevant.

 

[Orange56]

I think you want:

rs.FindFirst "UserName = '" & Environ("UserName") & "'"

I personally would open the recordset filtered rather than use FindFirst, but a user table is probably small enough to make it irrelevant.

Thank you, this fixed my problem. Is there a benefit of using the recordset filter? If so how would I implement it?

 

[pbaldy]

With your code, you're pulling the entire table over the network, then finding the record you need. The better method is to use SQL that only pulls the desired record over the network. Like I said, a user table is probably so small that it won't make a difference, but it's a good habit to be in. It would look like:

strSql = "SELECT * FROM tblUser WHERE UserName = '" & Environ("UserName") & "'"

Set rs = CurrentDb.OpenRecordset(strSql, dbOpenSnapshot, dbReadOnly)

And your test to see if it found the person changes to:

If rs.EOF Then