modify VBS AD-Query  to enter displayname in Excel Cell A1 instead of samaccountname

Posted on 2014-08-23
Last Modified: 2014-08-25
Hi experts,

could anybody change the code below to search the AD in Cell A1 from displayname like "jones, robert" instead from

Thanks in advance.

 Attribute VBA_ModuleType=VBAModule
Sub Module1
Rem Sub GetData()
Rem     For intRow = 2 To Cells(65536, 1).End(xlUp).Row
Rem         strUsername = Cells(intRow, "A").Value
Rem         strADsPath = Get_LDAP_User_Properties("user", Cells(1, "A").Value, strUsername, "adsPath")
Rem         If strADsPath <> "" Then
Rem             Set objUser = GetObject(strADsPath)
Rem             For intCol = 2 To Cells(1, 256).End(xlToLeft).Column
Rem                 On Error Resume Next
Rem                 strAttribute = Cells(1, intCol).Value
Rem                 strValue = objUser.Get(strAttribute)
Rem                 'If TypeName(strValue) = "Variant()" Then
Rem                     Cells(intRow, intCol).Value = strValue
Rem                 'Else
Rem                 '    Cells(intRow, intCol).Value = "<" & TypeName(strValue) & ">"
Rem                 'End If
Rem                 If Err.Number <> 0 Then Cells(intRow, intCol).Value = ""
Rem                 Err.Clear
Rem                 On Error GoTo 0
Rem             Next
Rem         End If
Rem     Next
Rem End Sub
Rem Private Function Get_LDAP_User_Properties(strObjectType, strSearchField, strObjectToGet, strCommaDelimProps)
Rem     ' This is a custom function that connects to the Active Directory, and returns the specific
Rem     ' Active Directory attribute value, of a specific Object.
Rem     ' strObjectType: usually "User" or "Computer"
Rem     ' strSearchField: the field by which to seach the AD by. This acts like an SQL Query's WHERE clause.
Rem     '             It filters the results by the value of strObjectToGet
Rem     ' strObjectToGet: the value by which the results are filtered by, according the strSearchField.
Rem     '             For example, if you are searching based on the user account name, strSearchField
Rem     '             would be "samAccountName", and strObjectToGet would be that speicific account name,
Rem     '             such as "jsmith".  This equates to "WHERE 'samAccountName' = 'jsmith'"
Rem     ' strCommaDelimProps: the field from the object to actually return.  For example, if you wanted
Rem     '             the home folder path, as defined by the AD, for a specific user, this would be
Rem     '             "homeDirectory".  If you want to return the ADsPath so that you can bind to that
Rem     '             user and get your own parameters from them, then use "ADsPath" as a return string,
Rem     '             then bind to the user: Set objUser = GetObject("LDAP://" & strReturnADsPath)
Rem     ' Now we're checking if the user account passed may have a domain already specified,
Rem     ' in which case we connect to that domain in AD, instead of the default one.
Rem     If InStr(strObjectToGet, "\") > 0 Then
Rem           arrGroupBits = Split(strObjectToGet, "\")
Rem           strDC = arrGroupBits(0)
Rem           strDNSDomain = strDC & "/" & "DC=" & Replace(Mid(strDC, InStr(strDC, ".") + 1), ".", ",DC=")
Rem           strObjectToGet = arrGroupBits(1)
Rem     Else
Rem     ' Otherwise we just connect to the default domain
Rem           Set objRootDSE = GetObject("LDAP://RootDSE")
Rem           strDNSDomain = objRootDSE.Get("defaultNamingContext")
Rem     End If
Rem     strBase = "<LDAP://" & strDNSDomain & ">"
Rem     ' Setup ADO objects.
Rem     Set adoCommand = CreateObject("ADODB.Command")
Rem     Set ADOConnection = CreateObject("ADODB.Connection")
Rem     ADOConnection.Provider = "ADsDSOObject"
Rem     ADOConnection.Open "Active Directory Provider"
Rem     adoCommand.ActiveConnection = ADOConnection
Rem     ' Filter on user objects.
Rem     'strFilter = "(&(objectCategory=person)(objectClass=user))"
Rem     strFilter = "(&(objectClass=" & strObjectType & ")(" & strSearchField & "=" & strObjectToGet & "))"
Rem     ' Comma delimited list of attribute values to retrieve.
Rem     strAttributes = strCommaDelimProps
Rem     arrProperties = Split(strCommaDelimProps, ",")
Rem     ' Construct the LDAP syntax query.
Rem     strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
Rem     adoCommand.CommandText = strQuery
Rem     ' Define the maximum records to return
Rem     adoCommand.Properties("Page Size") = 100
Rem     adoCommand.Properties("Timeout") = 30
Rem     adoCommand.Properties("Cache Results") = False
Rem     ' Run the query.
Rem     Set adoRecordset = adoCommand.Execute
Rem     ' Enumerate the resulting recordset.
Rem     strReturnVal = ""
Rem     Do Until adoRecordset.EOF
Rem         ' Retrieve values and display.
Rem         For intCount = LBound(arrProperties) To UBound(arrProperties)
Rem             If strReturnVal = "" Then
Rem                 If IsArray(adoRecordset.Fields(intCount).Value) Then
Rem                     For Each strValue In adoRecordset.Fields(intCount).Value
Rem                         If strReturnVal = "" Then
Rem                             strReturnVal = strValue
Rem                         Else
Rem                             strReturnVal = strReturnVal & ", " & strValue
Rem                         End If
Rem                     Next
Rem                 Else
Rem                     strReturnVal = adoRecordset.Fields(intCount).Value
Rem                 End If
Rem             Else
Rem                 If IsArray(adoRecordset.Fields(intCount).Value) Then
Rem                     For Each strValue In adoRecordset.Fields(intCount).Value
Rem                         strReturnVal = strReturnVal & ", " & strValue
Rem                     Next
Rem                 Else
Rem                     strReturnVal = strReturnVal & ", " & adoRecordset.Fields(intCount).Value
Rem                 End If
Rem             End If
Rem         Next
Rem         ' Move to the next record in the recordset.
Rem         adoRecordset.MoveNext
Rem     Loop
Rem     ' Clean up.
Rem     adoRecordset.Close
Rem     ADOConnection.Close
Rem     Get_LDAP_User_Properties = strReturnVal
Rem End Function
End Sub

Open in new window

Question by:Mandy_
    LVL 65

    Accepted Solution

    Hi, it should work if you put DisplayName in cella A1, then in cell A2 and beyond, put your display name to search for.

    LVL 2

    Author Comment

    you are right. Thank you
    LVL 65

    Expert Comment

    No problem, but can I ask why you gave the C grade?
    LVL 2

    Author Comment

    oh, sorry. how can i change that?
    LVL 65

    Expert Comment

    Hi Mandy, have you a chance to accept the solution to this question?
    LVL 2

    Author Closing Comment

    Thank you so much
    LVL 65

    Expert Comment

    No problem. Happy to help.

    Featured Post

    Gigs: Get Your Project Delivered by an Expert

    Select from freelancers specializing in everything from database administration to programming, who have proven themselves as experts in their field. Hire the best, collaborate easily, pay securely and get projects done right.

    Join & Write a Comment

    Mapping Drives using Group policy preferences Are you still using old scripts to map your network drives if so this article will show you how to get away for old scripts and move toward Group Policy Preference for mapping them. First things f…
    Deploying a Microsoft Access application in a Citrix environment is not difficult but takes a few steps. However, Citrix system people are often of little help, as they typically know next to nothing about Access. The script provided here will take …
    The viewer will learn how to create a normally distributed random variable in Excel, use a normal distribution to simulate the return on an investment over a period of years, Create a Monte Carlo simulation using a normal random variable, and calcul…
    This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.

    754 members asked questions and received personalized solutions in the past 7 days.

    Join the community of 500,000 technology professionals and ask your questions.

    Join & Ask a Question

    Need Help in Real-Time?

    Connect with top rated Experts

    17 Experts available now in Live!

    Get 1:1 Help Now