username and password for multiple users to access database (1 Viewer)

joe789

Registered User.
Local time
Today, 23:59
Joined
Mar 22, 2001
Messages
154
Hi Folks,

Once a ACCDE is opened, I am trying to figure out how to run a process in which a prompt box asks for a username then once that is entered a prompt box asks for a password then once that is entered if the username and password combination is found in a table the user is granted access otherwise they are presented with a message that they used a wrong username and/or password combination. What would be the easiest way to accomplish this? Any help would be greatly appreciated. I envision having the username and password combinations in a SQL table that is linked to the ACCDE so I can remove or add new users as needed.

Thank you very much,

Joe
 

Ranman256

Well-known member
Local time
Today, 18:59
Joined
Apr 9, 2015
Messages
4,337
I use the windows authentication. User fills in a box for userid and password, just like you need to start windows.

Code:
 'THIS IS THE CODE FOR THE FORM ONCLICK EVENT once user fills in userid/passord boxes
 Private Sub btnEnter_Click()
Dim sUser As String, sPass As String, sDom As String
 sUser = txtUser
sPass = txtPass
sDom = txtDom
 If WindowsLogin(sUser, sPass, sDom) Then
   mbSafe = True
   DoCmd.OpenForm "frmMainMenu"
   DoCmd.OpenForm "frmLogin"
   DoCmd.close
Else
   MsgBox "LOGIN INCORRECT", vbCritical, "Bad userid or password"
End If
End Sub
  
 Public Function WindowsLogin(ByVal strUserName As String, ByVal strpassword As String, ByVal strDomain As String) As Boolean
        'Authenticates user and password entered with Active Directory.
         On Error GoTo IncorrectPassword
        
        Dim oADsObject, oADsNamespace As Object
        Dim strADsPath As String
        
        strADsPath = "WinNT://" & strDomain
        Set oADsObject = GetObject(strADsPath)
        Set oADsNamespace = GetObject("WinNT:")
        Set oADsObject = oADsNamespace.OpenDSObject(strADsPath, strDomain & "\" & strUserName, strpassword, 0)
        
        WindowsLogin = True    'ACCESS GRANTED
        
ExitSub:
        Exit Function
        
IncorrectPassword:
        WindowsLogin = False   'ACCESS DENIED
        Resume ExitSub
End Function
 

Users who are viewing this thread

Top Bottom