• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 328
  • Last Modified:

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

Hi experts,

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

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 
Rem Private Function Get_LDAP_User_Properties(strObjectType, strSearchField, strObjectToGet, strCommaDelimProps)
Rem     
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     
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 
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 
Rem 
Rem     ' Filter on user objects.
Rem     'strFilter = "(&(objectCategory=person)(objectClass=user))"
Rem     strFilter = "(&(objectClass=" & strObjectType & ")(" & strSearchField & "=" & strObjectToGet & "))"
Rem 
Rem     ' Comma delimited list of attribute values to retrieve.
Rem     strAttributes = strCommaDelimProps
Rem     arrProperties = Split(strCommaDelimProps, ",")
Rem 
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 
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  
Rem     ' Clean up.
Rem     adoRecordset.Close
Rem     ADOConnection.Close
Rem     Get_LDAP_User_Properties = strReturnVal
Rem      
Rem End Function
Rem 
End Sub

Open in new window

0
Mandy_
Asked:
Mandy_
  • 4
  • 3
1 Solution
 
RobSampsonCommented:
Hi, it should work if you put DisplayName in cella A1, then in cell A2 and beyond, put your display name to search for.

Rob.
0
 
Mandy_Author Commented:
you are right. Thank you
0
 
RobSampsonCommented:
No problem, but can I ask why you gave the C grade?
0
Creating Active Directory Users from a Text File

If your organization has a need to mass-create AD user accounts, watch this video to see how its done without the need for scripting or other unnecessary complexities.

 
Mandy_Author Commented:
oh, sorry. how can i change that?
0
 
RobSampsonCommented:
Hi Mandy, have you a chance to accept the solution to this question?
0
 
Mandy_Author Commented:
Thank you so much
0
 
RobSampsonCommented:
No problem. Happy to help.
0

Featured Post

Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 4
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now