VBscript to retrieve Installed applications
I have servers in the domain and would like to retrieve the applications installed in each server.
I wonder if there is a script that can do that.
thanks
I wonder if there is a script that can do that.
thanks
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Sorry not sure what happen to the snippet formatting
zf
zf
'===Start copy: getapps.vbs===
' ---------------------------------------------------------------'
' getappversions.vbs
' 'Sample VBScript to query remote computers
' 'and return versions for word and excel.
' ''Author Riley C. aka ZooFan
' '''Version 2.9 - August 2007
' ''''www.experts-exchange.com question ID: 22735065
' ---------------------------------------------------------------'
'
Option Explicit
Const ForReading = 1, ForWriting = 2, ForAppending = 3 'FileObject Access Type
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0 'FileObject Format Type
Dim objFso
Dim objWshshell
Dim objOutputFile
Dim strCurPath
Dim dte
Dim tme
Dim arrPCnames()
Dim intPCLoop
Dim strNewFile
Dim strPCFile
Dim objPCOutputFile
Set objFso = CreateObject("Scripting.FileSystemObject")
Set objWshshell = WScript.CreateObject("WScript.Shell")
strCurPath = CreateObject("Scripting.FileSystemObject").GetAbsolutePathName(".")
dte = Replace(FormatDateTime(date(),vbshortdate),"/","-")
tme = Replace(Replace(FormatDateTime(now(),vbLongtime),":","-")," ","")
strNewFile = strCurPath & "\" & tme & "_" & dte & ".csv"
strPCFile = InputBox("Please enter the full path and file" & VbCrLf & "name of the file with the computer names.","Get application versions from remote computers..")
If Not objFso.FileExists(strPCFile) Then
MsgBox "You must enter a valid full path and file name!",vbOKOnly,"Get application versions from remote computers.."
WScript.Quit(0)
Elseif strPCFile = "" Then
MsgBox "You must enter a filename!",vbOKOnly,"Get application versions from remote computers.."
WScript.Quit(0)
Else
Call createoutputfile(strNewFile)
Call readpclist(strPCFile)
Set objOutputFile = objFso.OpenTextFile(strNewFile,ForWriting,TristateUseDefault)
objOutputFile.WriteLine("Computer,Apps List")
For intPCLoop = LBound(arrPCnames) To UBound(arrPCnames)
objOutputFile.WriteLine(arrPCnames(intPCLoop) & "," & InstalledApps(arrPCnames(intPCLoop)))
Next
objOutputFile.Close
MsgBox "File has been processed, and results saved in " & strNewFile ,vbOKOnly,"Get application versions from remote computers."
End If
WScript.Quit(0)
Sub readpclist(strPcList)
Dim objPCnames
Dim objReadFile
Dim intLneCount
Set objPCnames = objFso.GetFile(strPCFile)
Set objReadFile = objPCnames.OpenAsTextStream(ForReading, TristateUseDefault)
Do Until objReadFile.AtEndOfStream
ReDim Preserve arrPCnames(intLneCount)
arrPCnames(intLneCount) = objReadFile.ReadLine
intLneCount = intLneCount + 1
Loop
objReadFile.Close
End sub
Sub createoutputfile(strNewFileName)
If objFso.FileExists(strNewFileName) Then
objFso.deleteFile(strNewFileName)
Else
Set objOutputFile = objFso.CreateTextFile(strNewFileName)
objOutputFile.Close
End If
End Sub
Function InstalledApps(strPcName)
Dim appsFile
Dim strRegValue
Dim strKey
Dim intRegTest
Dim strBaseKey
Dim arSubKeys()
Dim strValue
Dim iErr
Dim iErr2
Dim testConn
Dim errMess
Const HKLM = &H80000002 'HKEY_LOCAL_MACHINE
On Error Resume Next
Set testConn = GetObject("winmgmts:\\" & strPcName,"Root\CIMV2")
iErr = Hex(Err.Number)
Select Case Ucase(iErr)
Case "1AD"
Set strRegValue = GetObject("winmgmts://" & strPcName & "/root/default:StdRegProv")
iErr2 = Hex(Err.Number)
Select Case Ucase(iErr2)
Case "1AD"
strBaseKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
intRegTest = strRegValue.EnumKey(HKLM, strBaseKey, arSubKeys)
For Each strKey In arSubKeys
intRegTest = strRegValue.GetStringValue(HKLM, strBaseKey & strKey, "DisplayName", strValue)
If intRegTest <> 0 Then
strRegValue.GetStringValue HKLM, strBaseKey & strKey, "QuietDisplayName", strValue
End If
If strValue <> "" Then
InstalledApps = InstalledApps & strValue & ","
End If
Next
Case Else
InstalledApps = Err.Description
End Select
Case Else
InstalledApps = Err.Description
End Select
End Function
'===End copy: getapps.vbs===ASKER
I get this message for each machine:
"The remote server machine does not exist or is unavailable"
"The remote server machine does not exist or is unavailable"
You are running this on a pc that is on the same subnet as the pc's your scanning yes?
verify the correct subnet, in the first question it ask
zf
verify the correct subnet, in the first question it ask
zf
ASKER
You are running this on a pc that is on the same subnet as the pc's your scanning yes?
YES ALL THE MACHINES ARE IN THE SAME SUBNET AS THE MACHINES FROM WHICH i AM RUNNING THE SCRIPT
YES ALL THE MACHINES ARE IN THE SAME SUBNET AS THE MACHINES FROM WHICH i AM RUNNING THE SCRIPT
ok....... "The remote server machine does not exist or is unavailable" it is a connectivity issue between the pc running the script and the domain computers not the script. You might want to make sure your client pc's are not blocking the script(IE: firewall?) WMI is enabled and can be accessed from a remote pc.
zf
zf
ASKER
even for the local computer.
double check the server.txt file your using, created in notepad? not Word, one pc per line with nothing else on the line?
verify WMI is functioning and service is running.
account permissions
firewall/connectivity
zf
verify WMI is functioning and service is running.
account permissions
firewall/connectivity
zf
ASKER
I have only the local machine name on the Notepad.
It still throws the message "The remote server machine does not exist or is unavailable"
It still throws the message "The remote server machine does not exist or is unavailable"
ASKER
can you try the script in your local computer, when you get a chance and see if it works for you?
thanks
thanks
I just recopied from the snippet window above and created a new text file with this local host in it and ran it, it ran here.
for the sake of our hair, copy the script below into notepad and save as a vbs file then run it locally.
It will test the WMI and net connection to the local pc. If this also fails its within your WMI or net connection if this passes then its something in the script were testing above that is not working.
zf
for the sake of our hair, copy the script below into notepad and save as a vbs file then run it locally.
It will test the WMI and net connection to the local pc. If this also fails its within your WMI or net connection if this passes then its something in the script were testing above that is not working.
zf
Option Explicit
On Error Resume Next
Const DEFAULT_COMPUTER = "localhost"
Const DEFAULT_NAMESPACE = "root\cimv2"
Dim objLoc
Dim objWmi
Dim strSysname
Dim strNamespace
Dim strUsername
Dim strPassword
Dim blnQuiet
strSysname = DEFAULT_COMPUTER
strNamespace = DEFAULT_NAMESPACE
strUsername = ""
strPassword = ""
blnQuiet = False
If fctIsAlive(strSysname) Then
If Not blnQuiet Then
WScript.Echo "ICMP Ping for " & strSysname & " passed."
WScript.Echo "Connecting to namespace " & strNamespace & " . . ."
End If
Set objLoc = WScript.CreateObject("WbemScripting.SWbemLocator")
Set objWmi = objLoc.ConnectServer(strSysname, strNamespace, strUsername, strPassword)
If Err.Number Then
If Not blnQuiet Then
WScript.Echo "Unable to connect to WMI: " & Err.Description
End If
Err.Clear
WScript.Quit(2)
Else
Set objWmi = Nothing
Set objLoc = Nothing
If Not blnQuiet Then
WScript.Echo "WMI successfully connected."
End If
WScript.Quit(0)
End If
Else
If Not blnQuiet Then
WScript.Echo "ICMP Ping for " & strSysname & " failed."
End If
WScript.Quit(1)
End If
Function fctIsAlive(strHostOrIP)
Dim objSh, objCmd, strCmd
strCmd = "%ComSpec% /C %SystemRoot%\system32\ping.exe -n 1 " & strHostOrIP & " | " _
& "%SystemRoot%\system32\find.exe /c /i " & Chr(34) & "ttl=" & Chr(34)
Set objSh = WScript.CreateObject("WScript.Shell")
Set objCmd = objSh.Exec(strCmd)
fctIsAlive = CBool(Trim(objCmd.StdOut.ReadAll))
Set objCmd = Nothing
Set objSh = Nothing
End Function
You can also change
Const DEFAULT_COMPUTER = "localhost"
to another pc and test it as well.
zf
Const DEFAULT_COMPUTER = "localhost"
to another pc and test it as well.
zf
ASKER
I tested it :
ICMP for the localhost passed
WMI Successfuly connected
ICMP for the localhost passed
WMI Successfuly connected
ASKER
ao it got to be the above script that needs a tweak
I have modified the code to NOT use a text file and only run on the local pc. Hoping to narrow it down please test and and let me know.
please do not edit it.
zf
please do not edit it.
zf
'===Start copy: getapps.vbs===
' ---------------------------------------------------------------'
' getappversions.vbs
' 'Sample VBScript to query remote computers
' 'and return versions for word and excel.
' ''Author Riley C. aka ZooFan
' '''Version 2.9 - August 2007
' ''''www.experts-exchange.com question ID: 22735065
' ---------------------------------------------------------------'
'
Option Explicit
Const ForReading = 1, ForWriting = 2, ForAppending = 3 'FileObject Access Type
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0 'FileObject Format Type
Dim objFso
Dim objWshshell
Dim objOutputFile
Dim strCurPath
Dim dte
Dim tme
Dim arrPCnames()
Dim intPCLoop
Dim strNewFile
Dim strPCFile
Dim objPCOutputFile
Set objFso = CreateObject("Scripting.FileSystemObject")
Set objWshshell = WScript.CreateObject("WScript.Shell")
strCurPath = CreateObject("Scripting.FileSystemObject").GetAbsolutePathName(".")
dte = Replace(FormatDateTime(date(),vbshortdate),"/","-")
tme = Replace(Replace(FormatDateTime(now(),vbLongtime),":","-")," ","")
strNewFile = strCurPath & "\" & tme & "_" & dte & ".csv"
' strPCFile = InputBox("Please enter the full path and file" & VbCrLf & "name of the file with the computer names.","Get application versions from remote computers..")
' If Not objFso.FileExists(strPCFile) Then
' MsgBox "You must enter a valid full path and file name!",vbOKOnly,"Get application versions from remote computers.."
' WScript.Quit(0)
' Elseif strPCFile = "" Then
' MsgBox "You must enter a filename!",vbOKOnly,"Get application versions from remote computers.."
' WScript.Quit(0)
' Else
Call createoutputfile(strNewFile)
'Call readpclist(strPCFile)
ReDim Preserve arrPCnames(1)
arrPCnames(0) = "."
Set objOutputFile = objFso.OpenTextFile(strNewFile,ForWriting,TristateUseDefault)
objOutputFile.WriteLine("Computer,Apps List")
For intPCLoop = LBound(arrPCnames) To UBound(arrPCnames)
objOutputFile.WriteLine(arrPCnames(intPCLoop) & "," & InstalledApps(arrPCnames(intPCLoop)))
Next
objOutputFile.Close
MsgBox "File has been processed, and results saved in " & strNewFile ,vbOKOnly,"Get application versions from remote computers."
' End If
WScript.Quit(0)
Sub readpclist(strPcList)
Dim objPCnames
Dim objReadFile
Dim intLneCount
Set objPCnames = objFso.GetFile(strPCFile)
Set objReadFile = objPCnames.OpenAsTextStream(ForReading, TristateUseDefault)
Do Until objReadFile.AtEndOfStream
ReDim Preserve arrPCnames(intLneCount)
arrPCnames(intLneCount) = objReadFile.ReadLine
intLneCount = intLneCount + 1
Loop
objReadFile.Close
End sub
Sub createoutputfile(strNewFileName)
If objFso.FileExists(strNewFileName) Then
objFso.deleteFile(strNewFileName)
Else
Set objOutputFile = objFso.CreateTextFile(strNewFileName)
objOutputFile.Close
End If
End Sub
Function InstalledApps(strPcName)
Dim appsFile
Dim strRegValue
Dim strKey
Dim intRegTest
Dim strBaseKey
Dim arSubKeys()
Dim strValue
Dim iErr
Dim iErr2
Dim testConn
Dim errMess
Const HKLM = &H80000002 'HKEY_LOCAL_MACHINE
On Error Resume Next
Set testConn = GetObject("winmgmts:\\" & strPcName,"Root\CIMV2")
iErr = Hex(Err.Number)
Select Case Ucase(iErr)
Case "1AD"
Set strRegValue = GetObject("winmgmts://" & strPcName & "/root/default:StdRegProv")
iErr2 = Hex(Err.Number)
Select Case Ucase(iErr2)
Case "1AD"
strBaseKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
intRegTest = strRegValue.EnumKey(HKLM, strBaseKey, arSubKeys)
For Each strKey In arSubKeys
intRegTest = strRegValue.GetStringValue(HKLM, strBaseKey & strKey, "DisplayName", strValue)
If intRegTest <> 0 Then
strRegValue.GetStringValue HKLM, strBaseKey & strKey, "QuietDisplayName", strValue
End If
If strValue <> "" Then
InstalledApps = InstalledApps & strValue & ","
End If
Next
Case Else
InstalledApps = Err.Description
End Select
Case Else
InstalledApps = Err.Description
End Select
End Function
'===End copy: getapps.vbs===
ASKER
for the local computer it worked.
I wonder from where it pull the application names,because I don't see them all in Add/Remove programs.
If you get a chance can you please tweak the script to write each application name on a separate line?
Thanks
I wonder from where it pull the application names,because I don't see them all in Add/Remove programs.
If you get a chance can you please tweak the script to write each application name on a separate line?
Thanks
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
This is a great script! Thanks guys.
How would I go about adding a "if BlahAppInstalled then msgbox "BlahAppInstalled is installed on computername" ?
How would I go about adding a "if BlahAppInstalled then msgbox "BlahAppInstalled is installed on computername" ?
copy and paste the script into notepad and save it as getapps.vbs
create a text file with one server name per line.
run the script and enter the server.txt file
the output files is created in the same folder that the script resides in.
zf
Open in new window