Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
?
Solved

Getting all installed apps from add remove programs of remote computers into excel

Posted on 2007-08-01
7
Medium Priority
?
1,710 Views
Last Modified: 2008-02-07
Hi,

I need a way to get all the installed applications in a machine to a excel file.I want to do this remotely.

Regards
Sharath
0
Comment
Question by:bsharath
  • 5
  • 2
7 Comments
 
LVL 12

Expert Comment

by:zoofan
ID: 19610227
I removed the word and excel version checks as the apps list includes the installed version of the office suite.

Output into a single excel csv doc
pcname,app,app,app,app

'===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.4 - August 2007
' ''''www.experts-exchange.com question ID: 22734176
' ---------------------------------------------------------------'
'
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)
                                                 For intPCLoop = LBound(arrPCnames) To UBound(arrPCnames)
                                                objOutputFile.WriteLine("Computer,Apps List")
                                                objOutputFile.WriteLine(arrPCnames(intPCLoop) & "," & InstalledApplications(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 InstalledApplications(pcName)
Dim appsFile
Dim oRegistry
Dim sBaseKey
Dim iRc
Dim sKey
Dim arSubKeys()
Dim sValue
 Const HKLM = &H80000002 'HKEY_LOCAL_MACHINE
 Set oRegistry = GetObject("winmgmts://" & pcName & "/root/default:StdRegProv")
 sBaseKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
 iRC = oRegistry.EnumKey(HKLM, sBaseKey, arSubKeys)

 For Each sKey In arSubKeys
  iRC = oRegistry.GetStringValue(HKLM, sBaseKey & sKey, "DisplayName", sValue)
  If iRC <> 0 Then
   oRegistry.GetStringValue HKLM, sBaseKey & sKey, "QuietDisplayName", sValue
  End If
  If sValue <> "" Then
  InstalledApplications = InstalledApplications & sValue & ","
   End If
 Next

End Function
'===End copy: getapps.vbs===


any problems let me know.  And I am alomost done with the script to create user folders with permissions but time to go to work so will not be able to finish until this evening.

zf
0
 
LVL 11

Author Comment

by:bsharath
ID: 19610295
I get this.

---------------------------
Windows Script Host
---------------------------
Script:      C:\Find all softwares installed in a remote machine.vbs
Line:      80
Char:      2
Error:      The remote server machine does not exist or is unavailable: 'GetObject'
Code:      800A01CE
Source:       Microsoft VBScript runtime error

---------------------------
OK  
---------------------------
0
 
LVL 12

Expert Comment

by:zoofan
ID: 19610316
oops forgot error checking,  sorry brb.



zf
0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 12

Accepted Solution

by:
zoofan earned 2000 total points
ID: 19610580
Sorry about that,  found a few other mistakes as well and fixed them,  did not run testing on nonexisting pc's my bad.

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

any problems let me know


zf
0
 
LVL 12

Expert Comment

by:zoofan
ID: 19610829
That one run ok?

zf
0
 
LVL 11

Author Comment

by:bsharath
ID: 19614225
Thanks a lot i get this working great.

I get the output like this
Dev-chen-pc2193      Microsoft Office Enterprise 2007      Microsoft Internationalized Domain
Dev-chen-pc1728      Beyond Compare Version 2.2.7      Belarc Advisor 7.2      Citrix ICA

Any way to get this sorted.

I mean scan all rows and sort all Microsoft Office Enterprise 2007 in the same row and another software if detected in the same row and so on.

0
 
LVL 12

Expert Comment

by:zoofan
ID: 19633604
I think the best way for you to handle the sort is to import this output into a database(inventory) and then you can query the database for all machines that say have "MS Office Enterprise 2007".

With the shear volume of data youve been collecting on all the pc's with these scripts at this point a database is going to be your only realistic method of keeping accurate track and orginization of all this information.  Unless this is a one time shot your going to end up will csv files coming out your ears if you dont find somewhere to collectivly put the data.  And if it is a one time shot, sort the data in excel.


zf
0

Featured Post

Keep up with what's happening at Experts Exchange!

Sign up to receive Decoded, a new monthly digest with product updates, feature release info, continuing education opportunities, and more.

Question has a verified solution.

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

Have you considered what group policies are backwards and forwards compatible? Windows Active Directory servers and clients use group policy templates to deploy sets of policies within your domain. But, there is a catch to deploying policies. The…
When you upgrade from Windows 8 to 8.1 or to Windows 10 or if you are like me you are on the Insider Program you may find yourself with many 450MB recovery partitions.  With a traditional disk that may not be a problem but with relatively smaller SS…
Windows 8 comes with a dramatically different user interface known as Metro. Notably missing from the new interface is a Start button and Start Menu. Many users do not like it, much preferring the interface of earlier versions — Windows 7, Windows X…
Windows 8 came with a dramatically different user interface known as Metro. Notably missing from that interface was a Start button and Start Menu. Microsoft responded to negative user feedback of the Metro interface, bringing back the Start button a…
Suggested Courses

580 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