vbscript to give the MS office service pack version does not work

I have been trying to get the following code written RobSampson to work but the output file simply says " unable to determine office version", "none" or "ping failed" for every computer that is there in the "computers.txt".  I know for a fact that these computers definitely have Office 2003, 2007 or 2010.

I also want to add the key for Office 2010
StrKey2010= "{90140000-0011-0000-0000-0000000FF1CE}"

Any thoughts on how to resolve the above issue?

 

Dim boolProductFound
Dim strDisplayName, strDisplayVersion, strInstallLocation
Dim strScriptPath, strServers, strServer, strFullPath, strFileOutputPath
Dim strKey2007, strKey2003, strKeyXPPro

Const HKEY_LOCAL_MACHINE = &H80000002

Set objFSO = CreateObject("Scripting.FileSystemObject")

strScriptPath = objFSO.GetParentFolderName(WScript.ScriptFullName)
If WScript.Arguments.Count = 0 Then
	strServers = "computers.txt"
Else
	strServers = WScript.Arguments.Item(0)
End If
strFullPath = strScriptPath & "\" & strServers

Set objInputFile = objFSO.OpenTextFile(strFullPath, 1)
strFileOutputPath = strScriptPath & "\" & "MS_Office_Version_Results_V3.csv"
Set objOutputFile = objFSO.OpenTextFile(strScriptPath & "\" & "MS_Office_Version_Results_V3.csv", 2, True)

objOutputFile.WriteLine "MS-Office Name and Version information"
objOutputFile.WriteLine "Server Name" & "," & "Product Name" & "," & "Version" & "," & "Errors?"

If IsEmpty(strServers)Then
	WScript.Echo "###########################################################"
	WScript.Echo "#     Usage: GetMsOfficeVersion_3.vbs ServerList.txt      #"
	WScript.Echo "#                                                         #"
	WScript.Echo "#     Important: You need to run this VBScript and        #"
	WScript.Echo "#                your serverlist.txt file from the        #"
	WScript.Echo "#                the same Directory path.                 #"
	WScript.Echo "#                                                         #"
	WScript.Echo "###########################################################"
	WScript.Quit
End If

Do While objInputFile.AtEndOfLine <> True
	strServer = ""
	strServer = objInputFile.ReadLine
	
	If Ping(strServer) Then
        strKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"
        strKey2007 = "{90120000-0011-0000-0000-0000000FF1CE}_PROPLUS_{0B36C6D6-F5D8-4EAF-BF94-4376A230AD5B}"
        strKey2003 = "{90110409-6000-11D3-8CFE-0150048383C9}"
        strKeyXPPro = "{90110409-6000-11D3-8CFE-0050048383C9}"
		
		
	  Set objLocator = CreateObject("WbemScripting.SWbemLocator")
      Set objService = objLocator.ConnectServer(strServer, "\root\Default", strDomain & "\" & strUsername, strPassword)
      Set objRegistry = objService.Get("StdRegProv")

		If Not (objRegistry) Is Nothing Then

			'Enumerate Registry
				boolProductFound = False
				objRegistry.EnumKey HKEY_LOCAL_MACHINE, strKey, arrSubKeys
				If IsNull(arrSubKeys) = False Then
					For Each strSubKey In arrSubKeys
						If (strSubKey = strKey2007) Then
							boolProductFound = True
							objRegistry.GetStringValue HKEY_LOCAL_MACHINE, strKey2007, "DisplayName", strDisplayName
							objOutputFile.WriteLine strServer & "," & strDisplayName & _
													"," & "N/A" & "," & "none"
						ElseIf (strSubKey = strKey2003) Then
							boolProductFound = True
							objRegistry.GetStringValue HKEY_LOCAL_MACHINE, strKey2003, "DisplayName", strDisplayName
							objRegistry.GetStringValue HKEY_LOCAL_MACHINE, strKey2003, "DisplayVersion", strDisplayVersion
							objOutputFile.WriteLine strServer & "," & strDisplayName & _
													"," & strDisplayVersion & "," & "none"
						ElseIf (strSubKey = strKeyXPPro) Then
							boolProductFound = True
							objRegistry.GetStringValue HKEY_LOCAL_MACHINE, strKeyXPPro, "DisplayName", strDisplayName
							objRegistry.GetStringValue HKEY_LOCAL_MACHINE, strKeyXPPro, "DisplayVersion", strDisplayVersion
							objOutputFile.WriteLine strServer & "," & strDisplayName & _
													"," & strDisplayVersion & "," & "none"
						End If
					
						strDisplayName = vbEmpty
						strDisplayVersion = vbEmpty
						strInstallLocation = vbEmpty
					Next
					If (boolProductFound = False) Then objOutputFile.WriteLine strServer & "," & "N/A" & "," & "N/A" & "," & "Unable to determine Office Version."
				Else
					objOutputFile.WriteLine strServer & "," & "N/A" & "," & "N/A" & "," & _
						"Unable to enumerate registry key."
				End If
		Else
			objOutputFile.WriteLine strServer & "," & "N/A" & "," & "N/A" & "," & _
									"Error Number: " & Err.Number & "; " & _
									"Unable to create Registry Object on remote server."
		End If
	Else
		objOutputFile.WriteLine strServer & "," & "N/A" & "," & "N/A" & "," & "Ping Failed"
	End If
Loop

'wscript.echo strAllDetails
MsgBox "The output file has been generated." & vbcrlf & "Please see """ & strFileOutputPath & """", vbOKOnly, "Output Finished"

'Ping Results
Function Ping(strServer)
	Dim objShell, boolCode
	Set objShell = CreateObject("WScript.Shell")
	boolCode = objShell.Run("Ping -n 2 -w 500 " & strServer, 0, True)
	
	If boolCode = 0 Then
		Ping = True
	Else
		Ping = False
	End If
	
	Set objShell = Nothing
End Function

Select allOpen in new window