Search of individual apps

This was more for entertainment just to mess with XML and AD more, and I guess to see who has applications that they shouldn't without me having to sift through ALL the installed apps, but I will share it anyway.
 
It allows you to search for indiviual programs on computers based off the key in HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall.
 
XML FILE:
<?xml version='1.0'?>
<Settings>
  <SearchFor>
   <!--This is based off the value of the subkeys of the HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall key-->
   <DisplayName Identity='Windows Internet Explorer 8'>ie8</DisplayName>
   <DisplayName Identity='Mozilla Firefox'>Mozilla Firefox</DisplayName>
   <DisplayName Identity='CCleaner'>CCleaner</DisplayName>
   <DisplayName Identity='Weather Bug'>{70DECFBF-9119-4434-B2D3-A3C283D15E45}</DisplayName>
   <DisplayName Identity='Advanced Registry Optimizer'>Advanced Registry Optimizer_is1</DisplayName>
   <DisplayName Identity='RegCure'>RegCure</DisplayName>
  </SearchFor>
 
  <ADSearch>
   <Domain>MYDOMAIN.NET</Domain>
   <PageSize>1000</PageSize>
   <SearchParameter>AComputer</SearchParameter>
   <SearchParameter>BComputer</SearchParameter>
   <SearchParameter>Comp*</SearchParameter>
  </ADSearch>

  </Settings>
 
 
vbs:
On Error Resume Next
'Option Explicit
Dim Config 'As Class
Dim sComputer 'As String
Dim oLog 'As Object
Dim iRow : iRow = 2 'As Integer
Set config = New Configuration
config.LoadSettings("Settings.xml")
Call CreateLog(config.Titles)
Call StartSearch(config.ComputersToSearch, config.Programs, config.Domain, config.PageSize)

Function Ping(sComputer)
  On Error Resume Next
 
  Dim sQuery 'As String
  Dim oQuerySearch, oPing 'As Object
 
  sQuery = "SELECT StatusCode FROM Win32_PingStatus WHERE Address = '" & sComputer & "'"
   
  Set oQuerySearch = GetObject("winmgmts:\\").ExecQuery(sQuery, "WQL", RETURN_IMMEDIATELY + FORWARD_ONLY)
  
  For Each oPing in oQuerySearch
   If oPing.StatusCode = 0 Then
    Ping = True
   Else
    Ping = False
   End If
  Next
End Function

Function GetRegConnection(sComputer)
  Set GetRegConnection = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
             sComputer & "\root\default:StdRegProv")
End Function

Sub CreateLog(aHeaders)
  Dim sHeader, sCol 'As String
  Dim iCol : iCol = 3 'As Integer
  Set oLog = CreateObject("Excel.Application")
 
  oLog.Workbooks.Add
 
  oLog.Cells(1,1).Value = "Computer Name"
  oLog.Cells(1,2).Value = "Ping"
  For Each sHeader In aHeaders
   oLog.Cells(1, iCol).Value = sHeader
   iCol = iCol + 1
  Next
 
  'Convert the Column into it's ASCII equivilant
  sCol = Chr(iCol + 64) & "1"
 
  oLog.Range("A1", sCol).Font.Bold = True
  oLog.Visible = True
End Sub
Sub Log(sText, iTargetRow, iTargetCol)
  oLog.Cells(iTargetRow, iTargetCol).Value = sText
End Sub

Sub StartSearch(aComputers, aPrograms, sDomain, iPageSize)
  Dim oRecordSet 'As Object
  'Dim aComputers 'As Array
  Dim sQuery, sComputer 'As String
 
  For Each sQuery In aComputers
   Set oRecordSet = GetComputers(sQuery, sDomain, iPageSize)
  
   oRecordSet.MoveFirst
   Do Until oRecordSet.EOF
    sComputer = oRecordSet.Fields("Name").Value
    If Ping(sComputer) Then
     CheckPrograms sComputer, aPrograms
    Else
     Log sComputer, iRow, 1
     Log "False", iRow, 2
     iRow = iRow + 1
    End If
   
    oRecordSet.MoveNext
   Loop
  Next
End Sub

Sub CheckPrograms(sComputer, aPrograms)
  On Error Resume Next
  Err.Clear
 
  Const HKLM = &H80000002
  Const APP_KEY = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
  Dim iCols : iCol = 3 'As Integer
  Dim iMatch : iMatch = 0 'As Integer
  Dim oReg 'As Object
  Dim sProgram 'As String
 
  Set oReg = GetRegConnection(sComputer)
 
  'Log the "static" results
  Log sComputer, iRow, 1
  Log "True", iRow, 2
 
  For Each sProgram In aPrograms
   oReg.EnumKey HKLM, APP_KEY, aSubKeys
  
   For Each sKey In aSubKeys
    If InStr(UCase(sKey), UCase(sProgram)) Then
     iMatch = iMatch + 1
    End If
   Next
  
   If iMatch <> 0 Then
    Log "Y", iRow, iCol
   Else
    Log "N", iRow, iCol
   End If
   
   iMatch = 0
  
   iCol = iCol + 1
  Next
 
  iRow = iRow + 1
End Sub
Function GetComputers(sQueryComputers, sDomain, iPageSize)
  Const ADS_SCOPE_SUBTREE = 2
  Dim oConnection, oCommand, oRecordSet 'As Object
  Dim aDomain 'As Array
 
  aDomain = Split(sDomain, ".")
 
  Set oConnection = CreateObject("ADODB.Connection")
  Set oCommand = CreateObject("ADODB.Command")
 
  oConnection.Provider = "ADsDSOObject"
  oConnection.Open "Active Directory Provider"
 
  oCommand.ActiveConnection = oConnection
  oCommand.CommandText = "SELECT Name FROM 'LDAP://DC=" & aDomain(0) & ",DC=" & aDomain(1) & _
       "' WHERE ObjectClass='Computer' AND Name='" & sQueryComputers & "'"
  oCommand.Properties("Page Size") = iPageSize
  oCommand.Properties("SearchScope") = ADS_SCOPE_SUBTREE
  Set GetComputers = oCommand.Execute
End Function
 
Class Configuration
  Private mSearchFor() 'As Array
  Private mTitles() 'As Array
  Private mComputersToSearch() 'As Array
  Private mDomainToSearch 'As String
  Private mPageSize 'As Integer
  
  Public Property Get Programs
   Programs = mSearchFor
  End Property
 
  Public Property Get Titles
   Titles = mTitles
  End Property
 
  Public Property Get ComputersToSearch
   ComputersToSearch = mComputersToSearch
  End Property
 
  Public Property Get Domain
   Domain = mDomainToSearch
  End Property
 
  Public Property Get PageSize
   PageSize = mPageSize
  End Property
    
  Private Sub Configuration_Initialize()
  End Sub
 
  Public Sub LoadSettings(sXMLFile)
   Dim oXMLDocument, oNode 'As Object
   Dim cNodeList 'As Collection
   Dim iCounter : iCounter = 0 'As Integer
  
   Set oXMLDocument = CreateObject("Microsoft.XMLDOM")
   oXMLDocument.Load(sXMLFile)
  
   'Get Applications to look for
   Set cNodeList = oXMLDocument.selectNodes("Settings/SearchFor/DisplayName")
   ReDim mSearchFor(cNodeList.Length - 1)
   ReDim mTitles(cNodeList.Length - 1)
  
   For Each oNode In cNodeList
    mSearchFor(iCounter) = oNode.Text
    mTitles(iCounter) = oNode.GetAttribute("Identity")
    iCounter = iCounter + 1
   Next
  
   'Get AD search parameters
   Set cNodeList = oXMLDocument.selectNodes("Settings/ADSearch/SearchParameter")
   ReDim mComputersToSearch(cNodeList.Length - 1)
  
   iCounter = 0
   For Each oNode In cNodeList
    mComputersToSearch(iCounter) = oNode.Text
    iCounter = iCounter + 1
   Next
  
   'Get Domain to Search
   Set oNode = oXMLDocument.selectSingleNode("Settings/ADSearch/Domain")
   mDomainToSearch = oNode.Text
  
   'Get page size for AD search
   Set oNode = oXMLDocument.selectSingleNode("Settings/ADSearch/PageSize")
   mPageSize = oNode.Text
     End Sub
End Class