Here's the script I used to audit software installations across our Windows network:
Option Explicit
On Error Resume Next
Const strInFile = "c:\scripts\audit\hosts.txt"
Const strOutFile = "C:\scripts\audit\results.csv"
Dim arrHosts, objHost, strHost
Dim objFSO, objTextFile
Dim i, strNextLine
Dim fileSystem, objOutFile
Set arrHosts = CreateObject("Scripting.Dictionary")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile(strInFile, 1)
i = 0
Do Until objTextFile.AtEndOfStream
strNextLine = objTextFile.Readline
arrHosts.Add i, strNextLine
i = i + 1
Loop
objTextFile.Close
Set objFSO = Nothing
Set fileSystem = WScript.CreateObject("Scripting.FileSystemObject")
Set objOutFile = FileSystem.CreateTextFile(strOutFile, True)
For Each objHost in arrHosts
strHost = arrHosts.Item(objHost)
WScript.Echo(strHost)
objOutFile.Write strHost
'---------------- using Win32_Product ----------------
Dim objWMIService
Dim arrItems1, arrItems2
Dim objItem1, objItem2
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strHost & "\root\cimv2")
Set arrItems1 = objWMIService.ExecQuery("SELECT * FROM Win32_OperatingSystem")
' Set arrItems2 = objWMIService.ExecQuery("SELECT * FROM Win32_Product")
' Set arrItems2 = objWMIService.ExecQuery("SELECT * FROM Win32_Product WHERE (Caption LIKE '%Office%')")
' Set arrItems2 = objWMIService.ExecQuery("SELECT * FROM Win32_Product WHERE SoftwareElementID = '{90280409-6000-11D3-8CFE-0050048383C9}'")
objOutFile.Write(",")
For Each objItem1 in arrItems1
Dim strCaption
strCaption = objItem1.Caption
strCaption = Replace(strCaption, ",", "")
strCaption = Replace(strCaption, ";", ":")
objOutFile.Write strCaption
WScript.Echo(" " & strCaption)
' objOutFile.Write "," & objItem1.Version
' objOutFile.Write "," & objItem1.InstallDate
' objOutFile.Write "," & objItem1.RegisteredUser
' objOutFile.Write "," & objItem1.SerialNumber
strCaption = vbEmpty
Next
'---------------- using the registry ----------------
Dim strKey, strSubKey
Dim objRegistry
Dim arrSubKeys()
Dim strDisplayName, strDisplayVersion, strInstallLocation
Const HKEY_LOCAL_MACHINE = &H80000002
strKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"
Set objRegistry = GetObject("winmgmts:{impersonationLevel=Impersonate}!\\" & strHost & "\root\default:StdRegProv")
objRegistry.EnumKey HKEY_LOCAL_MACHINE, strKey, arrSubKeys
objOutFile.Write(",")
For Each strSubKey In arrSubKeys
objRegistry.GetStringValue HKEY_LOCAL_MACHINE, strKey & "\" & strSubKey, "DisplayName", strDisplayName
' objRegistry.GetStringValue HKEY_LOCAL_MACHINE, strKey & "\" & strSubKey, "DisplayVersion", strDisplayVersion
' objRegistry.GetStringValue HKEY_LOCAL_MACHINE, strKey & "\" & strSubKey, "InstallLocation", strInstallLocation
If strDisplayName <> 0 Then
strDisplayName = Replace(strDisplayName, ",", "")
strDisplayName = Replace(strDisplayName, ";", ":")
objOutFile.Write(strDisplayName & ";")
WScript.Echo(" " & strDisplayName)
End If
strDisplayName = vbEmpty
strDisplayVersion = vbEmpty
strInstallLocation = vbEmpty
Next
Set objWMIService = Nothing
Set arrItems1 = Nothing
Set arrItems2 = Nothing
Set objRegistry = Nothing
objOutFile.Write vbcrlf
Next
objOutFile.Close
Set fileSystem = Nothing
