Macro: Query Active Directory with multiple usernames

[noodle88]

I am trying to query Active Directory for a list of user attributes by using a list of usernames and output the results into column B,C,D.....

All the usernames are listed in column A and it ranges from 100 to 1000 usernames.

The macro GetAdsProp works but it is very slow because it's a function and every time it gets called to return a value, it takes a long time to query. It will take forever to get 1000 users.

I've also tried the code below, however one of the AD attribute that I am querying for has a dash (i.e. test-address) and I can't put a dash in the vba code because it automatically puts spaces in between the dash and the text (see red text below) which will fail to find the attribute. Also, I need it to loop the whole column A and not just one account.

If anyone can help me, I would really appreciate it.


===============================================================================

Sub LoadUserInfo()
Dim x, objConnection, objCommand, objRecordSet, oUser, skip, disa
Dim sht As Worksheet

' get domain
Dim oRoot
Set oRoot = GetObject("LDAP://rootDSE")
Dim sDomain
sDomain = oRoot.Get("defaultNamingContext")
Dim strLDAP
strLDAP = "LDAP://" & sDomain

Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 100
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE


Dim username As String
username = Cells(2, 1)

objCommand.CommandText = "SELECT adsPath FROM '" & strLDAP & "' WHERE objectCategory='person'AND objectClass='user' AND sAMAccountName= '" & username & "'"
Set objRecordSet = objCommand.Execute

x = 2
Set sht = ThisWorkbook.Worksheets("Company")
With sht
' Clear and set Header info
.Cells.Clear
.Cells.NumberFormat = "@"
.Cells(1, 1).Value = "Login"
.Cells(1, 2).Value = "Name"
.Cells(1, 3).Value = "Surmane"
.Cells(1, 4).Value = "Display Name"
.Cells(1, 5).Value = "Departement"
.Cells(1, 6).Value = "Title"
.Cells(1, 7).Value = "Telephone"
.Cells(1, 8).Value = "Mobile"
.Cells(1, 9).Value = "Fax"
.Cells(1, 10).Value = "Initials"
.Cells(1, 11).Value = "Company"
.Cells(1, 12).Value = "Address"
.Cells(1, 13).Value = "P.O. box"
.Cells(1, 14).Value = "Zip"
.Cells(1, 15).Value = "Town"
.Cells(1, 16).Value = "State"

'Do Until objRecordSet.EOF

Set oUser = GetObject(objRecordSet.Fields("aDSPath"))
skip = oUser.sAMAccountName
disa = oUser.AccountDisabled

If skip = "jimmyt" Then


.Cells(x, 1).Value = CStr(oUser.sAMAccountName) 'Replace(oUser.Name, "CN=", "")
.Cells(x, 2).Value = oUser.givenName
.Cells(x, 3).Value = oUser.SN
.Cells(x, 4).Value = oUser.DisplayName
.Cells(x, 5).Value = oUser.department
.Cells(x, 6).Value = oUser.test - Address
.Cells(x, 7).Value = oUser.telephoneNumber
.Cells(x, 8).Value = oUser.mobile
.Cells(x, 9).Value = oUser.facsimileTelephoneNumber
.Cells(x, 10).Value = oUser.initials
.Cells(x, 11).Value = oUser.company
.Cells(x, 12).Value = oUser.streetAddress
.Cells(x, 13).Value = oUser.postOfficeBox
.Cells(x, 14).Value = oUser.postalCode
.Cells(x, 15).Value = oUser.l ' by
.Cells(x, 16).Value = oUser.st
DoEvents
x = x + 1
objRecordSet.MoveNext
End If

'Loop

End With
Range("A1:D1").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.AutoFilter
Range("C12").Select


End Sub

 

[jimrward]

you can refer to the items in a active directory recordset or for that fact any other recordset in a variety of ways, I used the following in the past to get around the same sort of problem, see the following snippet and adapt accordingly using the fields.items method

intNumRows=1
Do Until objrecordset.EOF
    intNumRows = intNumRows + 1
    DoEvents
    ActiveSheet.Range("A" & intNumRows).Offset(0, 0).Value = objrecordset.Fields.Item("Name")
    ActiveSheet.Range("A" & intNumRows).Offset(0, 1).Value = objrecordset.Fields.Item("DeviceName")
    ActiveSheet.Range("A" & intNumRows).Offset(0, 2).Value = objrecordset.Fields.Item("OSName")
    ActiveSheet.Range("A" & intNumRows).Offset(0, 3).Value = objrecordset.Fields.Item("PrimaryOwner")

    objrecordset.MoveNext
Loop

 

[noodle88]

Thank you jimrward. I tried the code you provided, but I am getting an error: "Runtime error 3265: Item cannot be found in the collection corresponding to the requested name or ordinal".

Can you provide your full code if possible?

 

[jimrward]

you can refer to the elements in a number of ways for instance

.Cells(x, 6).Value = oUser.test - Address

or

.Cells(x, 6).Value = oUser.fields.items("test - Address")

or

.Cells(x, 6).Value = oUser.fields.items where n is the position in the sequence, you might need to experiment with this