List all Groups on All Computers in a Domain, Caffeine Free version

This code consists of two main sections and a third section which is run at the very end. The first section simply queries Active Directory to fetch computer accounts. It then builds and populates a dictionary object with the "name" and "operatingSystem" values. The second portion sorts the dictionary object by the "name" key and then iterates the sorted list to query each computer for the groups it has.

Option Explicit

Const ADS_SCOPE_SUBTREE = 2
Const dictKey  = 1
Const dictItem = 2

Dim srvcount : srvcount = 0
Dim objRootDSE, strLDAP, computerName, computerOS
Dim d, i, strQuery, objConnection, objCommand, objRecordSet

Set objRootDSE = GetObject("LDAP://rootDSE")
strLDAP = objRootDSE.Get("defaultNamingContext")

Set d = CreateObject("Scripting.Dictionary")

strQuery = "Select Name, operatingSystem from 'LDAP://" & strLDAP & "' Where objectClass='computer'"

Set objConnection = CreateObject("ADODB.Connection")
Set objCommand =   CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"

Set objCOmmand.ActiveConnection = objConnection
objCommand.CommandText = strQuery
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
Set objRecordSet = objCommand.Execute
objRecordSet.MoveFirst

Do Until objRecordSet.EOF
 computerName = Ucase(objRecordSet("Name").value)
 computerOS   = objRecordSet("operatingSystem").value
 srvcount = srvcount + 1
 d.Add computerName, computerOS
 objRecordSet.MoveNext
Loop

'----------------------------------------------------------------
' comment: request dictionary sort and display results
'----------------------------------------------------------------

SortDictionary d, dictKey

For Each i In d
 computerName = i
 computerOS   = d(i)
 Wscript.Echo computerName & vbTab & computerOS
 If PingOnline(computerName) Then
  ListGroups computerName
 Else
  Wscript.Echo vbTab & "(offline)"
 End If
Next

'----------------------------------------------------------------
' function: sort dictionary object
'----------------------------------------------------------------

Function SortDictionary(objDict,intSort)
 Dim strDict()
 Dim objKey, strKey, strItem, X, Y, Z
 Z = objDict.Count
 If Z > 1 Then
  ReDim strDict(Z,2)
  X = 0
  For Each objKey In objDict
   strDict(X,dictKey)  = CStr(objKey)
   strDict(X,dictItem) = CStr(objDict(objKey))
   X = X + 1
  Next

  For X = 0 to (Z - 2)
   For Y = X to (Z - 1)
    If StrComp(strDict(X,intSort),strDict(Y,intSort),vbTextCompare) > 0 Then
     strKey  = strDict(X,dictKey)
     strItem = strDict(X,dictItem)
     strDict(X,dictKey)  = strDict(Y,dictKey)
     strDict(X,dictItem) = strDict(Y,dictItem)
     strDict(Y,dictKey)  = strKey
     strDict(Y,dictItem) = strItem
    End If
   Next
  Next
  objDict.RemoveAll
  For X = 0 to (Z - 1)
   objDict.Add strDict(X,dictKey), strDict(X,dictItem)
  Next
 End If
End Function

'----------------------------------------------------------------
' function: query groups on remote computer
'----------------------------------------------------------------

Sub ListGroups(strComputer)
 On Error Resume Next
 Dim objComputer, objX
 Set objComputer = GetObject("WinNT://" & strComputer)
 If err.Number <> 0 Then
  Wscript.Echo vbTab & "*** unable to query qroups ***"
  Exit Sub
 Else
  For each objX in objComputer
   If Lcase(objX.Class) = "group" Then
    Wscript.Echo vbTab & objX.Name
   End If
  Next
 End If
 Set objComputer = Nothing
End Sub

'----------------------------------------------------------------
' function: attempt ping to verify availability of computer
'----------------------------------------------------------------

Function PingOnline(strComputer)
 Dim objPing, objStatus
 Set objPing = GetObject("winmgmts:")._
  ExecQuery("select * from Win32_PingStatus where address = '" & strComputer & "'")
 For Each objStatus In objPing
  If IsNull(objStatus.StatusCode) Or (objStatus.StatusCode <> 0) Then
   Exit Function
  End If
  PingOnline = True
  Exit Function
 Next
End Function