How can you run a Query using Active Directory values?

[Raven7738]

Hey,

So I originally had a form asking for an ID and password. A query would take those two values and pull up information in a database that contained both those values. I need to change this so that instead of a user putting in this information, the query will look up both of these values in the active directory and pull up information on the user.

Any ideas of how I might go about this?

I am using Access 2007
Thank you.

[ADezii]

Hey,

So I originally had a form asking for an ID and password. A query would take those two values and pull up information in a database that contained both those values. I need to change this so that instead of a user putting in this information, the query will look up both of these values in the active directory and pull up information on the user.

Any ideas of how I might go about this?

I am using Access 2007
Thank you.

The Syntax would be comparable to this:

'First, you must set a Reference to the Active DS Type Library
Dim sysInfo As Object
Dim oUser As Object
Dim intUser As Integer
Dim strLastName As String
Dim strFirstName As String
Dim strSQL As String

Set sysInfo = CreateObject("ADSystemInfo")
Set oUser = GetObject("LDAP://" & sysInfo.UserName & "")

strUserName = sysInfo.UserName

intUser = InStr(strUserName, ",")
strLastName = Mid(strUserName, 4, (intUser - 4))

strFirstName = Right(strUserName, ((Len(strUserName) - intUser) - 3))
intUser = InStr(strFirstName, ",")
strFirstName = Left(strFirstName, intUser - 1)

'Set Criteria on Employees Table based on the First and Last Name
strSQL = "SELECT * FROM Employees WHERE [FirstName] = '" & strFirstName & _
         "' AND [LastName] = '" & strLastName & "';"

Set sysInfo = Nothing
Set oUser = Nothing

[maxamis4]

Hey,

So I originally had a form asking for an ID and password. A query would take those two values and pull up information in a database that contained both those values. I need to change this so that instead of a user putting in this information, the query will look up both of these values in the active directory and pull up information on the user.

Any ideas of how I might go about this?

I am using Access 2007
Thank you.

Here are a couple links to get you started. The previous post gives you a good way of doing it already:

http://activexperts.com/activmonitor/windowsmanagement/scripts/activedirectory/user/passwords/#ListWhenPasswordExpires.htm

http://www.petri.co.il/ldap_search_samples_for_windows_2003_and_exchange.htm

Here are the general variables used:
'###### Active Directory variables ######
strName = usr.get("givenN ame") '###### Users Christian Name ######
strSurname = usr.get("sn") '###### Users Surname ######
strInitials = usr.get("initia ls") '###### Users Initials ######
displayName = usr.get("displa yName") '###### Full Display Name ######
strAddress = usr.get("Street Address") '###### Address Information ######
strRoom = usr.get("Physic alDeliveryOffic eName") '###### Room/Area Information ######
secretary = usr.get("secret ary") '###### Secrectary/Assistant ######
strTitle = usr.get("title" ) '###### Job Title ######
strTelephone = usr.get("teleph oneNumber") '###### Official Intneral Telephone Number ######
strFax = usr.get("facsim ileTelephoneNum ber") '###### Fax Number ######
mobile = usr.get("mobile ") '###### Mobile Number ######
telephoneAssist ant = usr.get("teleph oneAssistant") '###### Telephone Assistant ######
strDepartment = usr.get("depart ment") '###### Department ######
strCC = usr.get("Extens ionAttribute1") '###### COST Centre ######
strBuilding = usr.get("Extens ionAttribute2") '###### Building ######
strDivision = usr.get("Extens ionAttribute3") '###### Division ######
strBranch = usr.get("Extens ionAttribute4") '###### Branch ######
ExtensionAttrib ute5 = usr.get("Extens ionAttribute5") '###### PC Item Number ######
ExtensionAttrib ute6 = usr.get("Extens ionAttribute6") '###### External Telephone Number ######
strGroup = usr.get("Extens ionAttribute7") '###### Group ######
othertelephone = usr.get("othert elephone") '###### GTN Telephone Number ######
samaccountname = usr.get("samacc ountname") '###### User ID ######
adspath = usr.get("adspat h") '###### Pathway to AD? ######
strFullName = usr.get("cn") '###### Full Display Name ######
strMail = usr.get("mail") '###### E-Mail Address ######
strManager = usr.get("manage r")

[NeoPa]

As passwords are never stored unencrypted (by professionals at least and certainly not in the AD) it won't be possible to compare the password data at all.

I'm afraid I don't know AD well enough to point you at a method for checking the credentials. I suspect there may be one, but I'm not certain, as even for a standard PC log on, it will only allow the check if the account for the PC itself has already been verified (IE. The PC must be a member of the domain itself or, alternatively, a member of a trusted domain).

I think these waters may be murkier than you'd imagined, but good luck anyway.

[Raven7738]

My final solution:

Private Declare Function WNetGetUser Lib "mpr.dll" _
Alias "WNetGetUserA" (ByVal lpName As String, ByVal sUser As String, lpnLength As Long) As Long

Private Sub Form_Load()

Const lpnLength As Integer = 255
Dim status As Integer
Dim lpName, sUser As String
Dim Edt As String



sUser = Space$(lpnLength + 1)
status = WNetGetUser(lpName, sUser, lpnLength)

If status = NoError Then
    sUser = Left$(sUser, InStr(sUser, Chr(0)) - 1)
    Else
        MsgBox "Unable to get the name."
    End
End If

txtUser = sUser

End Sub

Thank you for all your input!

[NeoPa]

Thanks for posting Raven. I'm a little unclear though, does that handle the password or logging in side of things? I can't see where if it does. Getting the password is the tricky bit of course.

[maxamis4]

AD Authentication

This is one of my functions used for LDAP authentication. Not sure if we are done with the post but it works well.

Keep in mind it only checks to make sure the password and user ID are accurate in AD.

Function LDAP_Password_Authentication(txtname, txtPassword, MyDomain)
On Error GoTo Err_Form_Timer
    Dim objRootDSE, strDNSDomain, strQuery, adoRecordset, strName, strCN, strLastLogin
    Dim DomainString As String
    
'======================================================================
'SET DOMAIN LOGIN
'======================================================================
DomainString = MyDomain & "\" & txtname
'======================== END DOMAIN LOGIN ============================

'======================================================================
' Setup ADO objects.
'======================================================================

    Set adoCommand = CreateObject("ADODB.Command")
    Set adoConnection = CreateObject("ADODB.Connection")
    adoConnection.Provider = "ADsDSOObject"
    adoConnection.Open "Active Directory Provider"
    adoCommand.ActiveConnection = adoConnection

'===========================END ADO SETUP==============================


'======================================================================
'CONNECTION TO LDAP
'======================================================================
    ' Search entire Active Directory domain.
    
    Set objRootDSE = GetObject("LDAP://RootDSE")
    
    strDNSDomain = objRootDSE.Get("defaultNamingContext")
    strBase = "<LDAP://" & strDNSDomain & ">;"
 
'=========================END CONNECTION===============================

'======================================================================
'SETUP CRITERIA
'======================================================================
    strBaseDN = strBase
    strFilter = "(&(objectClass=user)(objectCategory=person));"
    strAttrs = "cn;"
    strScope = "subtree"
'==========================END CRITERIA================================

    Set objConn = CreateObject("ADODB.Connection")
    objConn.Provider = "ADsDSOObject"
    objConn.Properties("User ID") = DomainString
    objConn.Properties("Password") = txtPassword
    objConn.Open "Active Directory Provider"
    
    'SEND AUTHENTICATION INFORMATION
    On Error GoTo myError

    Set objRS = objConn.Execute(strBaseDN & strFilter & strAttrs & strScope)
    

        LDAP_Password_Authentication = True
        
'*****************UPDATE PASSWORD FIELD NOTE STORED FOR 30 DAYS*************************
'OPEN DATABASE CONNECTION////////////////////////////////////
rsql = "AUTHENTICATE PASSWORD AND USERID AGAINST ACCESS TABLE"

Set db = CurrentDb()
Set rs = db.OpenRecordset(rsql, dbOpenDynaset)
'////////////////////////////////////////////////////////////
            rsql = "UPDATE LOG ENTRY FOR USER AUTHENTICATING"
            CurrentDb.Execute (rsql)

'***************************END FIELD UPDATE*****************************************************
myError:
    If Err.Number <> 0 Then
        'MsgBox "failed " & Err.Description
        LDAP_Password_Authentication = False

    End If


SET rs = Nothing

SET rsql = Nothing

Exit_Form_Timer:
    Exit Function

Err_Form_Timer:
    MsgBox "Server could not be found please check connection"
    Resume Exit_Form_Timer



End Function

[Raven7738]

Thanks for posting Raven. I'm a little unclear though, does that handle the password or logging in side of things? I can't see where if it does. Getting the password is the tricky bit of course.

The password is no longer needed. Originally I had it so that the user had to manually log in, so the password was only so others couldn't edit others information. Now the code pulls the username from the already logged in user and filters information from the database using that information. The username is output into a hidden text field (txtUser) which a query uses as a filter.

[NeoPa]

That makes perfect sense Raven.

Just for clarity though, and to include other possible options, I include links to a couple of threads (Retrieve User ID & Function to Return UserName (NT Login) of Current User) that work on similar lines.