Get list of all user with attributes from AD with VBA
<p>I'm having trouble with some VBA programming since I'm totally new to it.
I've been given the task to create a macro/vba application in Word/excel that retrieves Lastname, Firstname | telephone number | Department | Manager from the Active Directory.
So I've been searching the internet for the last days but nothing really works for me.
A Template that gets the current Users First-/Lastname, email etc. was given to work on. I am having a hard time on transferring the code to what i need to do now.
So what I've been trying for the past hours now, was getting a list of all the Users from the Active Directory. But the Code I use was from a VBScript I found on the internet. I changed what I could to make it work with VBA but I always get an error when trying to run it.
The code is the following:</p>

<pre><code>    Sub test()
' get OU
'

strOU = "OU=Users,DC=domain,DC=com"

' connect to active directory
'

Set objConnection = CreateObject("ADODB.Connection")
objConnection.Open "Provider=ADsDSOObject;"

' create command
'

Set objCommand = CreateObject("ADODB.Command")
objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 1000

' execute command to get all users
'

objCommand.commandtext = "LDAP://" &amp; strOU &amp; "&gt;;" &amp; _
  "(&amp;(objectclass=user)(objectcategory=person));" &amp; _
  "adspath,distinguishedname,sAMAccountName;subtree"

On Error Resume Next
Set objRecordSet = objCommand.Execute
If Err.Number &lt;&gt; 0 Then MsgBox "Exception occured: " &amp; Err.Description
On Error GoTo 0

'Dim RecordSet As New ADODB.RecordSet
Set objRecordSet = objCommand.Execute

'Show info for each user in OU
'

Do Until objRecordSet.EOF

  'Show required info for a user
  '

  Debug.Print obj.RecordSet.Fields(“adspath”).Value
  Debug.Print obj.RecordSet.Fields(“distinguishedname”).Value
  Debug.Print obj.RecordSet.Fields(“sAMAccountName”).Value

  ' Move to the next user
  '

  obj.RecordSet.MoveNext

Loop

' Clean up
'

obj.RecordSet.Close

Set obj.RecordSet = Nothing
Set objCommand = Nothing

objConnection.Close
Set objConnection = Nothing

End Sub
</code></pre>

<p>and in this line it all stops everytime:</p>

<pre><code>Set objRecordSet = objCommand.Execute
</code></pre>

<p>if I remove the <code>If Err.Number &lt;&gt; 0 Then MsgBox "Exception occured: " &amp; Err.Description
On Error GoTo 0</code> part it just freezes and crashes word.</p>