LDAP Query Not working For All Groups

D

Dan

I wrote an LDAP query using VBA in Excel. It is suppossed to return all the
groups to which a user belongs, directrly or indirectly. However, the
recursion only occurs on smome groups, not others. I can not for the life of
me figure out why. Can anybody see any errors in the code below? Thanks so
much if you can!

Dim y
Dim strSpacer
Sub ldap()
Sheets("Sheet1").Select

'Queries AD for all User Names
On Error Resume Next
Set con = CreateObject("ADODB.Connection")
Set cmd = CreateObject("ADODB.command")
Set rst = CreateObject("ADODB.RecordSet")

'defines the type of DB we are connecting to
con.Provider = "ADsDSOObject"
con.Open

cmd.ActiveConnection = con
cmd.Properties("Page Size") = 20000
'Submit the query
cmd.CommandText = "<LDAP://DC=capitol,DC=local>;(cn=Gary Stockton);name,
ADsPath"

Set rst = cmd.Execute
y = 2
Do Until rst.EOF
Range("a" & y).Select
Selection.Font.Bold = True
Range("a" & y).Value = rst.Fields("name")
Range("b" & y).Value = rst.Fields("ADsPath")
Range("c" & y).Value = rst.Fields("class")
ListGroups
rst.MoveNext
y = y + 1

Loop

End Sub

Private Sub ListGroups()
On Error Resume Next
Set Object = GetObject(Range("B" & y).Value)
objMemberOf = Object.GetEx("MemberOf")
strSpacer = strSpacer & " "
For Each objGroup In Object.memberOf
If Not objGroup = Empty Then
y = y + 1
strQuery = "LDAP://" & objGroup
Set Object = GetObject(strQuery)
Range("a" & y).Value = strSpacer & Mid(Object.Name, 4,
Len(Object.Name) - 3)
Range("b" & y).Value = Object.ADsPath
ListGroups
End If
Next
strSpacer = Left(strSpacer, Len(strSpacer) - 6)
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top