Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

VBscript to retrieve Installed applications

Posted on 2009-05-04
19
Medium Priority
?
3,037 Views
Last Modified: 2012-05-06
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

0
Comment
Question by:jskfan
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
19 Comments
 
LVL 75

Assisted Solution

by:käµfm³d 👽
käµfm³d   👽 earned 200 total points
ID: 24301153
0
 
LVL 12

Expert Comment

by:zoofan
ID: 24301631
This is a vbscript I wrote that will export the installed apps list to an csv.

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

'===Start copy: getapps.vbs===
' ---------------------------------------------------------------'
' getapps.vbs
' 'Sample VBScript to query remote computers
' ''Author Riley C. aka ZooFan
' ---------------------------------------------------------------'
'
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===

Open in new window

0
 
LVL 12

Expert Comment

by:zoofan
ID: 24301643
Sorry not sure what happen to the snippet formatting






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===

Open in new window

0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 

Author Comment

by:jskfan
ID: 24305754
I get this message for each machine:
"The remote server machine does not exist or is unavailable"
0
 
LVL 12

Expert Comment

by:zoofan
ID: 24306042
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
0
 

Author Comment

by:jskfan
ID: 24306150
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
0
 
LVL 12

Expert Comment

by:zoofan
ID: 24306197
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
0
 

Author Comment

by:jskfan
ID: 24307052
even for the local computer.
0
 
LVL 12

Expert Comment

by:zoofan
ID: 24307123
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
0
 

Author Comment

by:jskfan
ID: 24307562
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"
0
 

Author Comment

by:jskfan
ID: 24307818
can you try the script in your local computer, when you get a chance and see if it works for you?
thanks
0
 
LVL 12

Expert Comment

by:zoofan
ID: 24308073
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
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

Open in new window

0
 
LVL 12

Expert Comment

by:zoofan
ID: 24308091
You can also change

Const DEFAULT_COMPUTER  = "localhost"

to another pc and test it as well.



zf
0
 

Author Comment

by:jskfan
ID: 24308399
I tested it :

ICMP for the localhost passed
WMI Successfuly connected
0
 

Author Comment

by:jskfan
ID: 24308515
ao it got to be the above script that needs a tweak
0
 
LVL 12

Expert Comment

by:zoofan
ID: 24308652
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
'===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===

Open in new window

0
 

Author Comment

by:jskfan
ID: 24312537
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
0
 
LVL 12

Accepted Solution

by:
zoofan earned 1800 total points
ID: 24314551
This is for one pc, each app on one line,  edit line 25 to change the pc to scan no preceeding \\ in the name.

incorrect:  "\\pcname"
correct:       "pcname"



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 strPCname   
Dim strNewFile
Dim strPCFile
Dim objPCOutputFile
'Edit computer name to scan
            strPCname = "localhost"
 
      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 & ".txt"
            Call createoutputfile(strNewFile)
            Set objOutputFile = objFso.OpenTextFile(strNewFile,ForWriting,TristateUseDefault)
                                                objOutputFile.WriteLine("Computer name: " & strPCname & VbCrLf & VbCrLf & InstalledApps(strPCname))
                              objOutputFile.Close                                                
                  MsgBox "File has been processed, and results saved in " & strNewFile ,vbOKOnly,"Get application versions from remote computers."      
      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 & VbCrLf
                                                      End If
                                          Next
                                    Case Else
                                          InstalledApps = Err.Description      
                              End Select
                  Case Else
                        InstalledApps = Err.Description
            End Select
 
End Function
'===End copy: getapps.vbs===

Open in new window

0
 
LVL 2

Expert Comment

by:supportemea
ID: 24767820
This is a great script! Thanks guys.

How would I go about adding a "if BlahAppInstalled then msgbox "BlahAppInstalled is installed on computername" ?

0

Featured Post

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Recently I finished a vbscript that I thought I'd share.  It uses a text file with a list of server names to loop through and get various status reports, then writes them all into an Excel file.  Originally it was put together for our Altiris server…
This is pretty cool.  The purpose of this VB Script is to help you document where JAR (Java ARchive) files and specifically java class files are located so that you can address issues seen with a client or that you can speak intelligently with a dev…
Monitoring a network: how to monitor network services and why? Michael Kulchisky, MCSE, MCSA, MCP, VTSP, VSP, CCSP outlines the philosophy behind service monitoring and why a handshake validation is critical in network monitoring. Software utilized …
Sometimes it takes a new vantage point, apart from our everyday security practices, to truly see our Active Directory (AD) vulnerabilities. We get used to implementing the same techniques and checking the same areas for a breach. This pattern can re…

670 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question