Excel, VBA, and ADODB issue: Can't get the right fields displayed.

Question

If this isn't the right forum for this question, please let me know where to put it. Thanks!

I've got this tool that's supposed to go to Active Directory and grab all of the user records. It then puts all of the fields from each record into a worksheet in Excel. Unfortunately, while it seems to work, the data on each line is for a different user in each column. The code is at the end.

This is an example. I changed the names somewhat so they wouldn't violate privacy laws, but the names truly are different from each other.

c
company
department	Marlborough Hub
description	Sales Supp, Director
displayName	Pat Trimbal
distinguishedName	CN=Betty Chang,OU=NC-Charlotte,OU=Southeast,DC=ourdomain,DC=com
dNSHostname
givenName
homeDrive	H:
homephone
l	Pittsburgh
legacyExchangeDN	/o=Ourcompany Sales/ou=PA-PHL/cn=Recipients/cn=PEpper
location
mail
mailNickname
manager	CN=John Ferguson,OU=AL-Pelham,OU=Southeast,DC=ourdomain,DC=com
mAPIRecipient	TRUE
mDBUseDefaults	TRUE
mobile	123 456 7890
msExchHomeServerName	/o=Ourdomain Sales/ou=Exchange Administrative Group (FYDIBOHF23SPDLT)/cn=Configuration/cn=Servers/cn=FL-LEX-MBX-01
name	Sue Farmer
objectCategory	CN=Person,CN=Schema,CN=Configuration,DC=ourdomain,DC=com
objectClass	top
ObjectClass	top
OU
physicalDeliveryOfficeName	BPO / SS
postalCode	33637
profilePath
proxyAddresses	X400:C=US;A= ;P=Ourdomain Sales;O=FL-JAX;S=Black;G=Jenny;
rID
sAMAccountName	KClark
sAMAccountName	LVacaro
showInAddressBook	CN=Tampa,CN=Offices,CN=All Address Lists,CN=Address Lists Container,CN=Ourdomain Sales,CN=Microsoft Exchange,CN=Services,CN=Configuration,DC=ourdomain,DC=com
SN	Seitser
st	FL
streetAddress	12345 Telephone Drive , Suite 100
targetAddress
telephoneNumber	123-456-7890
url
userAccountControl	512
userAccountControl;2

Here's the code. "CommandText" is a list of 41 strings corresponding to the 41 fields for which I'm looking:

Sub DisplayADAttributes()
  
  Const subtree = 2
  
  ' Variables, early binding
  Dim objConnection As ADODB.Connection
  Dim objCommand As ADODB.Command
  Dim objRecordSet As ADODB.Recordset
  Dim objRecord As ADODB.Record
  
  Dim RecordNum As Integer
  Dim FieldNum As Integer
  Dim NumberOfRecords As Integer
  Dim NumberOfAttributes As Integer
  Dim CommandText As String
  
  CommandText = ""
  Sheets("Attributes").Select
  SortByColumn ColumnNum:=1
  NumberOfAttributes = Sheets("Attributes").Cells(1, 2)
  ReDim AttributeList(1 To NumberOfAttributes)
  For FieldNum = 1 To NumberOfAttributes
    CommandText = CommandText & Trim(Sheets("Attributes").Cells(FieldNum + 1, 3)) & ", "
  Next FieldNum
  CommandText = Left(CommandText, Len(CommandText) - 2)
  
  ' Object initializations, early binding
  Set objConnection = New ADODB.Connection
  objConnection.Provider = "ADsDSOObject"
  objConnection.Open "Active Directory Provider"
  
  Set objCommand = New ADODB.Command
  Set objCommand.ActiveConnection = objConnection
  objCommand.Properties("Page Size") = 100
  objCommand.Properties("Searchscope") = subtree
   
  objCommand.CommandText = "<LDAP://dc=ourdomain,dc=com>;(objectClass=*);" & CommandText & ";" & subtree
  
  Set objRecordSet = objCommand.Execute
  Sheets("Entries").Columns("A:ZZ").Delete
  For FieldNum = 0 To objRecordSet.Fields.Count - 1
    Sheets("Entries").Cells(1, 1 + FieldNum) = objRecordSet.Fields(FieldNum).Name
  Next FieldNum
  
  RecordNum = 0
  objRecordSet.MoveFirst
  Do While (Not objRecordSet.EOF) And RecordNum <= 50
    For FieldNum = 0 To objRecordSet.Fields.Count - 1
      Sheets("Entries").Cells(RecordNum + 2, FieldNum + 1).Value = _
          objRecordSet.Fields(FieldNum).Value
      objRecordSet.MoveNext
    Next FieldNum
    Set objRecord = Nothing
    RecordNum = RecordNum + 1
  Loop
  
  Sheets("Entries").Select
  Cells.EntireColumn.AutoFit
  With ActiveWindow
    .SplitColumn = 0
    .SplitRow = 1
  End With
  ActiveWindow.FreezePanes = True
End Sub ' DisplayADAttributes

I'm stumped

Answer 1

Hi,

I will involve some experts who are familiar with your issue, this may take some time. Much appreciate for your patience and understanding.

Have a good day.

Regards,

---

Leo_Gao [MSFT]
MSDN Community Support | Feedback to us

Answer 2

So is the trouble that you have a different user in each column instead of each row?

Answer 3

"Unfortunately, while it seems to work, the data on each line is for a different user in each column. "

Not sure I understand. Are you saying the data in column B doesn't match up with the correct information in column A?

Will Buffington
Microsoft Excel Support

Answer 4

On any given row, each cell contains data from a different Active Directory record. Only the first column contains information for the record they're all supposed to be grabbing data from.

Answer 5

I don't know if you ever figured this out but it you need to move the MoveNext method out of the For loop

Do While (Not objRecordSet.EOF) And RecordNum <= 50
    For FieldNum = 0 To objRecordSet.Fields.Count - 1
      Sheets("Entries").Cells(RecordNum + 2, FieldNum + 1).Value = _
          objRecordSet.Fields(FieldNum).Value
      ' objRecordSet.MoveNext <- need to move
    Next FieldNum
    objRecordSet.MoveNext ' move here

    Set objRecord = Nothing
    RecordNum = RecordNum + 1
  Loop

---

Les Zatony, HSB

Answer 6

That was the problem! Thank you!!!