'-------------
Private Sub btnLogin_Click()
'-------------
Dim sUser As String, sPass As String, sDom As String
dim vID, vDbID
sUser = txtUser
sPass = txtPass
sDom = txtDom
vID= Environ("Username")
vDbID = Dlookup("[userId]","tUsers","[UserID]='" & vID & "'"
If WindowsLogin(sUser, sPass, sDom) and vID = vDbID 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