Error with LDAP in VBA

[SomeDumGuy]

I have some code that is not behaving very well. It is designed to recursively list every group to which a user belongs. However, it does not list the "memberOf" for all groups- it does for some. I am starting to think that if there is only one group in the "memberOf" field, that is when it fails. Can anybody spot the error in the following code?

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=Here,DC=com>;(cn=John Doe);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")
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