Active Directory Query Function GetAdsProp for all domains

[Dastrip]

Hello, I am sure some of you have seen the code for GetAdsProp before.
Oringaly found here. Query Active Directory from Excel

Function GetAdsProp(ByVal SearchField As String, ByVal SearchString As String, ByVal ReturnField As String) As String    ' Get the domain string ("dc=domain, dc=local")
    Dim strDomain As String
    strDomain = GetObject("LDAP://rootDSE").Get("defaultNamingContext")
    
    ' ADODB Connection to AD
    Dim objConnection As ADODB.Connection
    Set objConnection = CreateObject("ADODB.Connection")
    objConnection.Open "Provider=ADsDSOObject;"
        
    ' Connection
    Dim objCommand As ADODB.Command
    Set objCommand = CreateObject("ADODB.Command")
    objCommand.ActiveConnection = objConnection
        
    ' Search the AD recursively, starting at root of the domain
    objCommand.CommandText = _
        "<ldap: "="" &="" strdomain="">;(&(objectCategory=User)" & _
        "(" & SearchField & "=" & SearchString & "));" & SearchField & "," & ReturnField & ";subtree"


    ' RecordSet
    Dim objRecordSet As ADODB.Recordset
    Set objRecordSet = objCommand.Execute
         
    
    If objRecordSet.RecordCount = 0 Then
        GetAdsProp = "not found"  ' no records returned
    Else
        GetAdsProp = objRecordSet.Fields(ReturnField)  ' return value
    End If
     
    ' Close connection
    objConnection.Close
    
    ' Cleanup
    Set objRecordSet = Nothing
    Set objCommand = Nothing
    Set objConnection = Nothing
End Function

My question is not that I can't get this code to work.
I need this code to query all Domains, currently it will only query the domain as the logged on user.

I have found this code from another person that claims it does that, however I could not get it to work.

Function GetAdsProp2(ByVal strDomain, ByVal SearchField, ByVal SearchString, ByVal ReturnField, ByVal ObjType)Dim adoCommand, objConnection, StrQuery
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Open "Provider=ADsDSOObject;"
Set adoCommand = CreateObject("ADODB.Command")
adoCommand.ActiveConnection = objConnection
If SearchField = "" Then
StrQuery = "(objectCategory=" & ObjType & ")" & ";" & ReturnField & ";subtree"
Else
StrQuery = "(&(objectCategory=" & ObjType & ")" & "(" & SearchField & "=" & SearchString & ")" & ");" & SearchField & "," & ReturnField & ";subtree"
End If
adoCommand.CommandText = "<ldap: "="" &="" strdomain="">;" & StrQuery
Dim objRecordSet
Set objRecordSet = adoCommand.Execute
If objRecordSet.RecordCount = 0 Then
GetAdsProp = "Not Found"
Else
Do Until objRecordSet.EOF
GetAdsProp = GetAdsProp & objRecordSet.Fields(ReturnField) & vbLf
objRecordSet.MoveNext
Loop
End If
objConnection.Close
Set objRecordSet = Nothing
Set adoCommand = Nothing
Set objConnection = Nothing
End Function

This would be of great help if someone could solve.
Thank you.</ldap:></ldap:>

 

[Dastrip]

Any Takers?