View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
dan dan is offline
external usenet poster
 
Posts: 866
Default LDAP Query Not working For All Groups

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