Need to find if 1 specific software is installed in all machine names in the file and output the machine names that has the software.
Hi,
Need to find if 1 specific software is installed in all machine names in the file and output the machine names that has the software.
For licensing issue i need to scan for just specific softwares. Any way to do this.
REgards
Sharath
Need to find if 1 specific software is installed in all machine names in the file and output the machine names that has the software.
For licensing issue i need to scan for just specific softwares. Any way to do this.
REgards
Sharath
ASKER
I will need to track major softwares
Visio
MS project
Office 2003
Office 2007
Sql Server
Oracle
and some more softwares as such
Visio
MS project
Office 2003
Office 2007
Sql Server
Oracle
and some more softwares as such
Well, if you create a list and what to check for (as you have the apps and know how/what is done during the install) I will gladly write the checking.
zf
zf
ASKER
zoofan
If each of these softwares can be checked in the Add/Remove programs that would be enough.
You want me to check any thing?
If each of these softwares can be checked in the Add/Remove programs that would be enough.
You want me to check any thing?
ASKER
Any help on this...
Finishing up the mp3 delete then will start.
zf
zf
is that the complete list?
Visio
MS project
Office 2003
Office 2007
Sql Server
Oracle
if not can you post it or email it too me.
ee DOT zoofan (at) gm@1L DOT c0m
zf
Visio
MS project
Office 2003
Office 2007
Sql Server
Oracle
if not can you post it or email it too me.
ee DOT zoofan (at) gm@1L DOT c0m
zf
ASKER
Here is the complete list
Visio 2003/2007
MS project 2002/2003/2007
Office 97/2000/2003 /2007
Sql Server client/server
Oracle client / server
winzip
winrar
one note
Visio 2003/2007
MS project 2002/2003/2007
Office 97/2000/2003 /2007
Sql Server client/server
Oracle client / server
winzip
winrar
one note
Ok, from a pc or pc's that have this software installed run regedit and goto
HKEY_LOCAL_MACHINE\SOFTWAR
Highlight the uninstall key and goto file export. select 'selected branch' name it and save it.
Attach the file/files to here.
I need to see what is in the uninstall key (all apps in add/remove are listed in the uninstallkey ) to determine what I have to check for as I do not have almost all of these.
I doubt highly youll have one pc with everything so I expect more then one file.
zf
Unless your feeling energetic you can export just the appropriate key for the app and post those. Faster for me harder for you
HKEY_LOCAL_MACHINE\SOFTWAR
HKEY_LOCAL_MACHINE\SOFTWAR
Highlight the uninstall key and goto file export. select 'selected branch' name it and save it.
Attach the file/files to here.
I need to see what is in the uninstall key (all apps in add/remove are listed in the uninstallkey ) to determine what I have to check for as I do not have almost all of these.
I doubt highly youll have one pc with everything so I expect more then one file.
zf
Unless your feeling energetic you can export just the appropriate key for the app and post those. Faster for me harder for you
HKEY_LOCAL_MACHINE\SOFTWAR
Actually while reading thru other questions last night I found this very sweet vbs from RobSampson,
ID:20838080
"Anyway guys, here's a VBS I have written that gets computers names from a text file called "computers.txt" and output their installed apps to Excel:"
https://www.experts-exchange.com/questions/23143400/Script-that-queries-the-registry-for-all-the-applications-that-are-installed-on-a-domain-member-pc.html?sfQueryTermInfo=1+replac+win32_product
I see no point in reinventing the wheel. He deserves the points for that one, very elegant.
zf
ID:20838080
"Anyway guys, here's a VBS I have written that gets computers names from a text file called "computers.txt" and output their installed apps to Excel:"
https://www.experts-exchange.com/questions/23143400/Script-that-queries-the-registry-for-all-the-applications-that-are-installed-on-a-domain-member-pc.html?sfQueryTermInfo=1+replac+win32_product
I see no point in reinventing the wheel. He deserves the points for that one, very elegant.
zf
ASKER
zoofan ya ROb is a real genius i have 100's of his solutions documented. And this already one.
Here i need to search for specific softwares.
I already have solutions to get all softwares installed in each system in each sheet.
But searching for a specific software is installed. :-)
Here i need to search for specific softwares.
I already have solutions to get all softwares installed in each system in each sheet.
But searching for a specific software is installed. :-)
Just take the first loop test and change the compare to only log what you want
If ((strDisplayName <> "") AND (strDisplayName = strMYAPPNAME1 OR strDisplayName = strMYAPPNAME2 OR strDisplayName = strMYAPPNAME3 OR strDisplayName = strMYAPPNAME4)) Then
And for the second loop test to only log what you want
For Each objSoftware in colAllSoftware
If ((objSoftware.Name <> "") AND (objSoftware.Name = strMYAPPNAME1 OR objSoftware.Name = strMYAPPNAME2 OR objSoftware.Name = strMYAPPNAME3 OR objSoftware.Name = strMYAPPNAME4)) Then
'Remaining code from script
End if
Next
You have the names and they MUST as you know match EXACTLY what is returned.
run the full script on a few machines until you have all the correct display names then use those display names to refine the return(only return if that app found).
zf
(Rob is da' Man)
If ((strDisplayName <> "") AND (strDisplayName = strMYAPPNAME1 OR strDisplayName = strMYAPPNAME2 OR strDisplayName = strMYAPPNAME3 OR strDisplayName = strMYAPPNAME4)) Then
And for the second loop test to only log what you want
For Each objSoftware in colAllSoftware
If ((objSoftware.Name <> "") AND (objSoftware.Name = strMYAPPNAME1 OR objSoftware.Name = strMYAPPNAME2 OR objSoftware.Name = strMYAPPNAME3 OR objSoftware.Name = strMYAPPNAME4)) Then
'Remaining code from script
End if
Next
You have the names and they MUST as you know match EXACTLY what is returned.
run the full script on a few machines until you have all the correct display names then use those display names to refine the return(only return if that app found).
zf
(Rob is da' Man)
' **********************************************************************
' ********** START OF FIRST METHOD - Add / Remove Programs ************
' **********************************************************************
strKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"
'MsgBox "Ping successful on: " & strComputer
On Error Resume Next
Set objRegistry = GetObject("winmgmts:" & _
"{impersonationLevel=Impersonate}!\\" & _
strComputer & "\root\default:StdRegProv")
If Err.Number <> 0 Then
MsgBox "There was a problem connecting to: " & strComputer & "."
If strInactivePCs = "" Then
strInactivePCs = strSinglePC
Else
strInactivePCs = strInactivePCs & vbCrLf & strSinglePC
End If
Err.Clear
On Error GoTo 0
Else
objRegistry.EnumKey HKEY_LOCAL_MACHINE, strKey, arrSubKeys
On Error Resume Next
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
'strAllDetails = strAllDetails & strComputer & ";" & strSubKey & ";" & strDisplayName & ";" & strDisplayVersion & VbCrLf
If strDisplayName <> "" Then
If boolShowMSKBPatches = False Then
If InStr(strDisplayName, " KB") = 0 And InStr(strDisplayName, "(KB") = 0 Then
If strAllDetails = "" Then
strAllDetails = strAllDetails & strComputer & ";" & strUserName & ";" & strDisplayName & ";" & strDisplayVersion
Else
strAllDetails = strAllDetails & VbCrLf & strComputer & ";" & strUserName & ";" & strDisplayName & ";" & strDisplayVersion
End If
End If
Else
If strAllDetails = "" Then
strAllDetails = strAllDetails & strComputer & ";" & strUserName & ";" & strDisplayName & ";" & strDisplayVersion
Else
strAllDetails = strAllDetails & VbCrLf & strComputer & ";" & strUserName & ";" & strDisplayName & ";" & strDisplayVersion
End If
End If
End If
strDisplayName = vbEmpty
strDisplayVersion = vbEmpty
strInstallLocation = vbEmpty
Next
On Error GoTo 0
' **********************************************************************
' *********** END OF FIRST METHOD - Add / Remove Programs ***************
' **********************************************************************
' *********** START OF SECOND METHOD - Windows Installer ****************
' **********************************************************************
'Set objWMIService = GetObject("winmgmts:" _
' & "{impersonationLevel=impersonate}!\\" _
' & strComputer & "\root\cimv2")
Set colAllSoftware = objWMIService.ExecQuery _
("Select * from Win32_Product")
On Error Resume Next
For Each objSoftware in colAllSoftware
'strAllSoftware = strAllSoftware & "Name: " & objSoftware.Name & vbcrlf & "Version: " & objSoftware.Version & vbcrlf
If strAllDetails = "" Then
If InStr(strAllDetails, ";" & objSoftware.Name & ";") = 0 Then
strAllDetails = strAllDetails & strComputer & ";" & strUserName & ";" & objSoftware.Name & ";" & objSoftware.Version
End If
Else
If InStr(strAllDetails, ";" & objSoftware.Name & ";") = 0 Then
strAllDetails = strAllDetails & VbCrLf & strComputer & ";" & strUserName & ";" & objSoftware.Name & ";" & objSoftware.Version
End If
End If
Next
On Error GoTo 0
' **********************************************************************
' *********** END OF SECOND METHOD - Windows Installer *****************
' **********************************************************************
As a more complete example This script will query the pc's listed in computers.txt
and ONLY log those which have Adobe Reader 6.0
zf
and ONLY log those which have Adobe Reader 6.0
zf
'===================
'********************************************************************
' This function uses the following Reg Key:
' SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\
' to return the list of programs that are listed in the Add / Remove
' Programs applet of the control panel.
'
' GetOfficeDetails.vbs uses a WQL query of "SELECT * FROM Win32_Product"
' to obtain the list of software products that have been installed
' using the Microsoft Windows Installer.
'********************************************************************
Option Explicit
Dim strWorkingDir
Dim strAllPCsFile, objAllPCsFile, strSearchResultsFile, strOutputFile
Dim strSinglePC, strComputer, arrSinglePC, strKey, strSubKey, strUserName
Dim objRegistry
Dim arrSubKeys()
Dim strDisplayName, strDisplayVersion, strInstallLocation
Dim strScriptName, strScriptPath, strFileOutputPath
Dim strAllDetails, objFSO, objExec, strActivePCs, arrActivePCs, strInactivePCs
Dim arrResultsRows, arrResultsTable, intRowNum, intColNum
Dim objWMIService, colAllSoftware, objSoftware, colComputer, objComputer
Dim boolShowMSKBPatches
Dim boolPinged
Dim arrComputerPrograms 'Global variable to hold the computer programs per computer
Const HKEY_LOCAL_MACHINE = &H80000002
Const intForReading = 1
Const intForWriting = 2
Const intForAppending = 8
strWorkingDir = Replace(WScript.ScriptFullName, WScript.ScriptName, "")
'MsgBox strWorkingDir
If Left(strWorkingDir, 2) = "\\" Then
MsgBox "Please run this program from a network drive.", vbOKOnly, "Error"
WScript.Quit
End If
boolShowMSKBPatches = MsgBox("Do you want to display Micorosoft KnowledgeBase Patches?", vbYesNo, "Display Patches?")
If boolShowMSKBPatches = vbYes Then
boolShowMSKBPatches = True
Else
boolShowMSKBPatches = False
End If
'MsgBox boolShowMSKBPatches
strAllPCsFile = "Computers.txt"
strSearchResultsFile = "Results.txt"
strOutputFile = "InactivePCs.txt"
strInactivePCs = ""
strAllDetails = ""
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objAllPCsFile = objFSO.OpenTextFile(strAllPCsFile, intForReading)
While Not objAllPCsFile.AtEndOfStream
strComputer = objAllPCsFile.ReadLine
'MsgBox "About to ping: " & strComputer
boolPinged = Ping(strComputer)
If boolPinged = True Then
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colComputer = objWMIService.ExecQuery _
("Select * from Win32_ComputerSystem")
For Each objComputer in colComputer
strUserName = "User Name: " & objComputer.UserName
Next
'WScript.Echo strComputer & " responded to ping."
' **********************************************************************
' ********** START OF FIRST METHOD - Add / Remove Programs ************
' **********************************************************************
strKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"
'MsgBox "Ping successful on: " & strComputer
On Error Resume Next
Set objRegistry = GetObject("winmgmts:" & _
"{impersonationLevel=Impersonate}!\\" & _
strComputer & "\root\default:StdRegProv")
If Err.Number <> 0 Then
MsgBox "There was a problem connecting to: " & strComputer & "."
If strInactivePCs = "" Then
strInactivePCs = strSinglePC
Else
strInactivePCs = strInactivePCs & vbCrLf & strSinglePC
End If
Err.Clear
On Error GoTo 0
Else
objRegistry.EnumKey HKEY_LOCAL_MACHINE, strKey, arrSubKeys
On Error Resume Next
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
'strAllDetails = strAllDetails & strComputer & ";" & strSubKey & ";" & strDisplayName & ";" & strDisplayVersion & VbCrLf
If strDisplayName <> "" And strDisplayName = "Adobe Reader 6.0" Then
If boolShowMSKBPatches = False Then
If InStr(strDisplayName, " KB") = 0 And InStr(strDisplayName, "(KB") = 0 Then
If strAllDetails = "" Then
strAllDetails = strAllDetails & strComputer & ";" & strUserName & ";" & strDisplayName & ";" & strDisplayVersion
Else
strAllDetails = strAllDetails & VbCrLf & strComputer & ";" & strUserName & ";" & strDisplayName & ";" & strDisplayVersion
End If
End If
Else
If strAllDetails = "" Then
strAllDetails = strAllDetails & strComputer & ";" & strUserName & ";" & strDisplayName & ";" & strDisplayVersion
Else
strAllDetails = strAllDetails & VbCrLf & strComputer & ";" & strUserName & ";" & strDisplayName & ";" & strDisplayVersion
End If
End If
End If
strDisplayName = vbEmpty
strDisplayVersion = vbEmpty
strInstallLocation = vbEmpty
Next
On Error GoTo 0
' **********************************************************************
' *********** END OF FIRST METHOD - Add / Remove Programs ***************
' **********************************************************************
' *********** START OF SECOND METHOD - Windows Installer ****************
' **********************************************************************
'Set objWMIService = GetObject("winmgmts:" _
' & "{impersonationLevel=impersonate}!\\" _
' & strComputer & "\root\cimv2")
Set colAllSoftware = objWMIService.ExecQuery _
("Select * from Win32_Product")
On Error Resume Next
For Each objSoftware in colAllSoftware
If objSoftware.Name <> "" And objSoftware.Name = "Adobe Reader 6.0" Then
'strAllSoftware = strAllSoftware & "Name: " & objSoftware.Name & vbcrlf & "Version: " & objSoftware.Version & VbCrLf
If strAllDetails = "" Then
If InStr(strAllDetails, ";" & objSoftware.Name & ";") = 0 Then
strAllDetails = strAllDetails & strComputer & ";" & strUserName & ";" & objSoftware.Name & ";" & objSoftware.Version
End If
Else
If InStr(strAllDetails, ";" & objSoftware.Name & ";") = 0 Then
strAllDetails = strAllDetails & VbCrLf & strComputer & ";" & strUserName & ";" & objSoftware.Name & ";" & objSoftware.Version
End If
End If
End if
Next
On Error GoTo 0
' **********************************************************************
' *********** END OF SECOND METHOD - Windows Installer *****************
' **********************************************************************
strActivePCs = strActivePCs & strComputer & ";"
End If
Else
If strInactivePCs = "" Then
strInactivePCs = strSinglePC
Else
strInactivePCs = strInactivePCs & vbCrLf & strSinglePC
End If
End If
Wend
If Right(strActivePCs, 1) = ";" Then
strActivePCs = Left(strActivePCs, Len(strActivePCs) - 1)
End If
arrActivePCs = Split(strActivePCs, ";")
' ********** Create the main Results Table array ************
If strAllDetails = "" Then
MsgBox "There are no results to display. Please check that any PCs are active."
WScript.Quit
End If
arrResultsRows = Split(strAllDetails, VbCrLf)
'MsgBox arrResultsRows(UBound(arrResultsRows))
'MsgBox Split(arrResultsRows(UBound(arrResultsRows)), ";")(0)
ReDim arrResultsTable(UBound(arrResultsRows), UBound(Split(arrResultsRows(0), ";")))
'MsgBox "STRING:" & Right(strAllDetails, 100) & ":STRING"
For intRowNum = LBound(arrResultsRows) To UBound(arrResultsRows)
For intColNum = LBound(Split(arrResultsRows(0), ";")) To UBound(Split(arrResultsRows(0), ";"))
'MsgBox intRowNum & ":" & intColNum
'If IsDate(Split(arrResultsRows(intRowNum), ";")(intColNum)) = False Then
arrResultsTable(intRowNum, intColNum) = Split(arrResultsRows(intRowNum), ";")(intColNum)
'Else
' arrResultsTable(intRowNum, intColNum) = CDate(Split(arrResultsRows(intRowNum), ";")(intColNum))
'End If
Next
Next
' ********** End of creating the main Results Table array **************
Output_To_Excel
Dim objFS
Dim objOutputFile
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objOutputFile = objFS.CreateTextFile(strOutputFile, True)
objOutputFile.Write(strInactivePCs)
objOutputFile.Close
MsgBox "InactivePCs have been recorded." & vbcrlf & "Please see " & strOutputFile & ".", vbOKOnly, "Output Finished"
'*************************************************************
Sub Output_To_Excel
Dim objExcel, objExcelWorkBook, intSheetCount
Dim strAllPrinters, intActivePCCounter
Dim intRowCounter, intColCounter
Dim intProgramCounter, intComputerProgramCount
If IsArray(arrResultsTable) = True Then
Set objExcel = CreateObject("EXCEL.APPLICATION")
objExcel.Visible = True
objExcel.WorkBooks.Add
Set objExcelWorkBook = objExcel.ActiveWorkbook
objExcelWorkBook.Activate
objExcel.DisplayAlerts = False
Do While objExcel.Sheets.Count > 1
objExcel.Sheets(1).Delete
Loop
objExcel.DisplayAlerts = True
' *************** All Printers ***************
' objExcel.Sheets(1).Name = "All Printers"
' Display_All_Printers "Excel", objExcel
' ********************************************
' *********** Individual Printers ************
For intActivePCCounter = LBound(arrActivePCs) To UBound(arrActivePCs)
objExcel.Sheets(1).Select
objExcel.Sheets.Add
objExcel.Sheets(1).Name = arrActivePCs(intActivePCCounter)
objExcel.Sheets(arrActivePCs(intActivePCCounter)).Move , objExcel.Sheets(objExcel.Sheets.Count)
objExcel.Sheets(arrActivePCs(intActivePCCounter)).Select
Next
objExcel.Sheets(1).Delete
objExcel.ScreenUpdating = False
Show_Computer_Programs objExcel
' ********************************************
objExcel.Sheets(1).Select
objExcel.ActiveSheet.Range("A1").Select
objExcel.ScreenUpdating = True
MsgBox "There were " & objExcel.Sheets.Count & " PCs inspected."
Set objExcelWorkBook = Nothing
Set objExcel = Nothing
Else
MsgBox "No programs have been retrieved. Cannot output to Excel."
End If
End Sub
'*************************************************************
Sub Write_Excel_Header_Row(objExcelApp)
Dim arrFields
Dim intColCounter, strLastColumn
arrFields = Array("Computer", "Owner", "Software", "Version")
For intColCounter = LBound(arrFields) To UBound(arrFields)
objExcelApp.ActiveSheet.Range(Chr(intColCounter + 65) & "1").FormulaR1C1 = arrFields(intColCounter)
Next
strLastColumn = Chr(UBound(arrFields) + 65)
objExcelApp.ActiveSheet.Range("A1:" & strLastColumn & "1").Font.Bold = True
objExcelApp.ActiveSheet.Range("A:" & strLastColumn).EntireColumn.AutoFit
objExcelApp.Cells.Select
objExcelApp.Selection.Sort objExcelApp.ActiveSheet.Range("C2"), 1, , , , , , 1, 1, False, 1
objExcelApp.ActiveSheet.Range("A1").Select
End Sub
'*************************************************************
Sub Show_Computer_Programs(objExcelObj)
Dim intProgramCounter, intComputerProgramCount, intRowCounter, intColCounter, intActivePCCounter
If IsArray(arrResultsTable) = True Then
For intActivePCCounter = LBound(arrActivePCs) To UBound(arrActivePCs)
intComputerProgramCount = 0
For intProgramCounter = LBound(arrResultsTable) To UBound(arrResultsTable)
'MsgBox "Table: " & arrResultsTable(intProgramCounter, 0) & " - ActivePC:" & arrActivePCs(intActivePCCounter)
If arrResultsTable(intProgramCounter, 0) = arrActivePCs(intActivePCCounter) Then
intComputerProgramCount = intComputerProgramCount + 1
End If
Next
ReDim arrComputerPrograms(intComputerProgramCount - 1, UBound(Split(arrResultsRows(0), ";")))
intRowCounter = 0
For intProgramCounter = LBound(arrResultsTable) To UBound(arrResultsTable)
If arrResultsTable(intProgramCounter, 0) = arrActivePCs(intActivePCCounter) Then
For intColCounter = LBound(Split(arrResultsRows(0), ";")) To UBound(Split(arrResultsRows(0), ";"))
arrComputerPrograms(intRowCounter, intColCounter) = arrResultsTable(intProgramCounter, intColCounter)
Next
intRowCounter = intRowCounter + 1
End If
Next
If UBound(arrComputerPrograms) > -1 Then
objExcelObj.Sheets(arrActivePCs(intActivePCCounter)).Select
Display_Single_Computer_Programs objExcelObj
Else
objExcelObj.Sheets(arrActivePCs(intActivePCCounter)).Select
Write_Excel_Header_Row objExcelObj
End If
Next
Else
MsgBox "No programs have been retrieved."
End If
End Sub
'*************************************************************
Sub Display_Single_Computer_Programs(objExcelObj)
Dim intRowCounter, intColCounter
objExcelObj.ActiveSheet.Cells.Select
objExcelObj.Selection.NumberFormat = "@"
For intRowCounter = LBound(arrComputerPrograms) To UBound(arrComputerPrograms)
For intColCounter = LBound(Split(arrResultsRows(0), ";")) To UBound(Split(arrResultsRows(0), ";"))
objExcelObj.ActiveSheet.Range(Chr(intColCounter + 65) & intRowCounter + 2).FormulaR1C1 = arrComputerPrograms(intRowCounter, intColCounter)
If InStr(arrComputerPrograms(intRowCounter, intColCounter), "<Error>") > 0 Then
objExcelObj.ActiveSheet.Range(Chr(intColCounter + 65) & intRowCounter + 2).Select
objExcelObj.Selection.Font.Bold = True
objExcelObj.Selection.Font.ColorIndex = 3
End If
Next
Next
Write_Excel_Header_Row(objExcelObj)
End Sub
'************* PING FUNCTION ********************
Function Ping(ByVal strName)
Dim objFSO, objShell, objTempFile, objTS, strTempFile
Dim strCommand, strReadLine
Dim boolReturn
Set objShell = WScript.CreateObject("Wscript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
strTempFile = strWorkingDir & "temp.txt"
'Set default return value
boolReturn = False
'Create command line to ping and save results to a temp file
strCommand = "cmd /c ping.exe -n 1 -w 500 " & strName & " > """ & strTempFile & """"
'Execute the command
objShell.Run strCommand, 0, True
'Open the temp text file
Set objTempFile = objFSO.GetFile(strTempFile)
Set objTS = objTempFile.OpenAsTextStream(1)
'Loop through the temp file to see if "reply from" is found,
'if it is then the ping was successful
Do While objTs.AtEndOfStream <> True
strReadLine = objTs.ReadLine
If InStr(LCase(strReadLine), "reply from") > 0 Then
boolReturn = True
Exit Do
End If
Loop
'Close temp file and release objects
objTS.Close
objTempFile.Delete True
Set objTS = Nothing
Set objTempFile = Nothing
Set objShell = Nothing
Set objFSO = Nothing
'Return value
Ping = boolReturn
End Function
'===================
Ok here, run the ORGINAL script on enough machines to get your correct application names for all 6 apps,
then edit these lines in this script with those corect display names.
Visio 2003/2007
MS project 2002/2003/2007
Office 97/2000/2003 /2007
Sql Server client/server
Oracle client / server
winzip
winrar
one note
strApp1 = "MY APP NAME" 'office97<-
strApp2 = "MY APP NAME" 'Offce2k
strApp3 = "MY APP NAME" 'Office03
strApp4 = "MY APP NAME" 'Office07
strApp5 = "MY APP NAME" 'Sql Cient
strApp6 = "MY APP NAME" 'Sql Server
strApp7 = "MY APP NAME" 'Oracle client
strApp8 = "MY APP NAME" 'Oracle server
strApp9 = "MY APP NAME" 'winzip
strApp10 = "MY APP NAME" 'winrar
strApp11 = "MY APP NAME" 'OneNote
strApp12 = "MY APP NAME" 'Visio 03
strApp13 = "MY APP NAME" 'Visio 07
It will run and only log the pc's that have those apps.
zf
then edit these lines in this script with those corect display names.
Visio 2003/2007
MS project 2002/2003/2007
Office 97/2000/2003 /2007
Sql Server client/server
Oracle client / server
winzip
winrar
one note
strApp1 = "MY APP NAME" 'office97<-
strApp2 = "MY APP NAME" 'Offce2k
strApp3 = "MY APP NAME" 'Office03
strApp4 = "MY APP NAME" 'Office07
strApp5 = "MY APP NAME" 'Sql Cient
strApp6 = "MY APP NAME" 'Sql Server
strApp7 = "MY APP NAME" 'Oracle client
strApp8 = "MY APP NAME" 'Oracle server
strApp9 = "MY APP NAME" 'winzip
strApp10 = "MY APP NAME" 'winrar
strApp11 = "MY APP NAME" 'OneNote
strApp12 = "MY APP NAME" 'Visio 03
strApp13 = "MY APP NAME" 'Visio 07
It will run and only log the pc's that have those apps.
zf
'===================
'********************************************************************
' This function uses the following Reg Key:
' SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\
' to return the list of programs that are listed in the Add / Remove
' Programs applet of the control panel.
'
' GetOfficeDetails.vbs uses a WQL query of "SELECT * FROM Win32_Product"
' to obtain the list of software products that have been installed
' using the Microsoft Windows Installer.
'********************************************************************
Option Explicit
Dim strWorkingDir
Dim strAllPCsFile, objAllPCsFile, strSearchResultsFile, strOutputFile
Dim strSinglePC, strComputer, arrSinglePC, strKey, strSubKey, strUserName
Dim objRegistry
Dim arrSubKeys()
Dim strDisplayName, strDisplayVersion, strInstallLocation
Dim strScriptName, strScriptPath, strFileOutputPath
Dim strAllDetails, objFSO, objExec, strActivePCs, arrActivePCs, strInactivePCs
Dim arrResultsRows, arrResultsTable, intRowNum, intColNum
Dim objWMIService, colAllSoftware, objSoftware, colComputer, objComputer
Dim boolShowMSKBPatches
Dim boolPinged
Dim strApp1
Dim strApp2
Dim strApp3
Dim strApp4
Dim strApp5
Dim strApp6
Dim strApp7
Dim strApp8
Dim strApp9
Dim strApp10
Dim strApp11
Dim strApp12
Dim strApp13
strApp1 = "MY APP NAME" 'office97<-
strApp2 = "MY APP NAME" 'Offce2k
strApp3 = "MY APP NAME" 'Office03
strApp4 = "MY APP NAME" 'Office07
strApp5 = "MY APP NAME" 'Sql Cient
strApp6 = "MY APP NAME" 'Sql Server
strApp7 = "MY APP NAME" 'Oracle client
strApp8 = "MY APP NAME" 'Oracle server
strApp9 = "MY APP NAME" 'winzip
strApp10 = "MY APP NAME" 'winrar
strApp11 = "MY APP NAME" 'OneNote
strApp12 = "MY APP NAME" 'Visio 03
strApp13 = "MY APP NAME" 'Visio 07
Dim arrComputerPrograms 'Global variable to hold the computer programs per computer
Const HKEY_LOCAL_MACHINE = &H80000002
Const intForReading = 1
Const intForWriting = 2
Const intForAppending = 8
strWorkingDir = Replace(WScript.ScriptFullName, WScript.ScriptName, "")
'MsgBox strWorkingDir
If Left(strWorkingDir, 2) = "\\" Then
MsgBox "Please run this program from a network drive.", vbOKOnly, "Error"
WScript.Quit
End If
boolShowMSKBPatches = MsgBox("Do you want to display Micorosoft KnowledgeBase Patches?", vbYesNo, "Display Patches?")
If boolShowMSKBPatches = vbYes Then
boolShowMSKBPatches = True
Else
boolShowMSKBPatches = False
End If
'MsgBox boolShowMSKBPatches
strAllPCsFile = "Computers.txt"
strSearchResultsFile = "Results.txt"
strOutputFile = "InactivePCs.txt"
strInactivePCs = ""
strAllDetails = ""
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objAllPCsFile = objFSO.OpenTextFile(strAllPCsFile, intForReading)
While Not objAllPCsFile.AtEndOfStream
strComputer = objAllPCsFile.ReadLine
'MsgBox "About to ping: " & strComputer
boolPinged = Ping(strComputer)
If boolPinged = True Then
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colComputer = objWMIService.ExecQuery _
("Select * from Win32_ComputerSystem")
For Each objComputer in colComputer
strUserName = "User Name: " & objComputer.UserName
Next
'WScript.Echo strComputer & " responded to ping."
' **********************************************************************
' ********** START OF FIRST METHOD - Add / Remove Programs ************
' **********************************************************************
strKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"
'MsgBox "Ping successful on: " & strComputer
On Error Resume Next
Set objRegistry = GetObject("winmgmts:" & _
"{impersonationLevel=Impersonate}!\\" & _
strComputer & "\root\default:StdRegProv")
If Err.Number <> 0 Then
MsgBox "There was a problem connecting to: " & strComputer & "."
If strInactivePCs = "" Then
strInactivePCs = strSinglePC
Else
strInactivePCs = strInactivePCs & vbCrLf & strSinglePC
End If
Err.Clear
On Error GoTo 0
Else
objRegistry.EnumKey HKEY_LOCAL_MACHINE, strKey, arrSubKeys
On Error Resume Next
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
'strAllDetails = strAllDetails & strComputer & ";" & strSubKey & ";" & strDisplayName & ";" & strDisplayVersion & VbCrLf
If ((strDisplayName <> "") And (strDisplayName = strApp1 or strDisplayName = strApp2 Or strDisplayName = strApp3 or strDisplayName = strApp4 or strDisplayName = strApp5 Or strDisplayName = strApp6 Or strDisplayName = strApp7 Or strDisplayName = strApp8 Or strDisplayName = strApp9 Or strDisplayName = strApp10 Or strDisplayName = strApp11 Or strDisplayName = strApp12 Or strDisplayName = strApp13)) Then
If boolShowMSKBPatches = False Then
If InStr(strDisplayName, " KB") = 0 And InStr(strDisplayName, "(KB") = 0 Then
If strAllDetails = "" Then
strAllDetails = strAllDetails & strComputer & ";" & strUserName & ";" & strDisplayName & ";" & strDisplayVersion
Else
strAllDetails = strAllDetails & VbCrLf & strComputer & ";" & strUserName & ";" & strDisplayName & ";" & strDisplayVersion
End If
End If
Else
If strAllDetails = "" Then
strAllDetails = strAllDetails & strComputer & ";" & strUserName & ";" & strDisplayName & ";" & strDisplayVersion
Else
strAllDetails = strAllDetails & VbCrLf & strComputer & ";" & strUserName & ";" & strDisplayName & ";" & strDisplayVersion
End If
End If
End If
strDisplayName = vbEmpty
strDisplayVersion = vbEmpty
strInstallLocation = vbEmpty
Next
On Error GoTo 0
' **********************************************************************
' *********** END OF FIRST METHOD - Add / Remove Programs ***************
' **********************************************************************
' *********** START OF SECOND METHOD - Windows Installer ****************
' **********************************************************************
'Set objWMIService = GetObject("winmgmts:" _
' & "{impersonationLevel=impersonate}!\\" _
' & strComputer & "\root\cimv2")
Set colAllSoftware = objWMIService.ExecQuery _
("Select * from Win32_Product")
On Error Resume Next
For Each objSoftware in colAllSoftware
If ((objSoftware.Name <> "") And (objSoftware.Name = strApp1 Or objSoftware.Name = strApp2 Or objSoftware.Name = strApp3 Or objSoftware.Name = strApp4 Or objSoftware.Name = strApp5 Or objSoftware.Name = strApp6 Or objSoftware.Name = strApp7 Or objSoftware.Name = strApp8 Or objSoftware.Name = strApp9 Or objSoftware.Name = strApp10 Or objSoftware.Name = strApp11 Or objSoftware.Name = strApp12 Or objSoftware.Name = strApp13)) Then
'strAllSoftware = strAllSoftware & "Name: " & objSoftware.Name & vbcrlf & "Version: " & objSoftware.Version & VbCrLf
If strAllDetails = "" Then
If InStr(strAllDetails, ";" & objSoftware.Name & ";") = 0 Then
strAllDetails = strAllDetails & strComputer & ";" & strUserName & ";" & objSoftware.Name & ";" & objSoftware.Version
End If
Else
If InStr(strAllDetails, ";" & objSoftware.Name & ";") = 0 Then
strAllDetails = strAllDetails & VbCrLf & strComputer & ";" & strUserName & ";" & objSoftware.Name & ";" & objSoftware.Version
End If
End If
End if
Next
On Error GoTo 0
' **********************************************************************
' *********** END OF SECOND METHOD - Windows Installer *****************
' **********************************************************************
strActivePCs = strActivePCs & strComputer & ";"
End If
Else
If strInactivePCs = "" Then
strInactivePCs = strSinglePC
Else
strInactivePCs = strInactivePCs & vbCrLf & strSinglePC
End If
End If
Wend
If Right(strActivePCs, 1) = ";" Then
strActivePCs = Left(strActivePCs, Len(strActivePCs) - 1)
End If
arrActivePCs = Split(strActivePCs, ";")
' ********** Create the main Results Table array ************
If strAllDetails = "" Then
MsgBox "There are no results to display. Please check that any PCs are active."
WScript.Quit
End If
arrResultsRows = Split(strAllDetails, VbCrLf)
'MsgBox arrResultsRows(UBound(arrResultsRows))
'MsgBox Split(arrResultsRows(UBound(arrResultsRows)), ";")(0)
ReDim arrResultsTable(UBound(arrResultsRows), UBound(Split(arrResultsRows(0), ";")))
'MsgBox "STRING:" & Right(strAllDetails, 100) & ":STRING"
For intRowNum = LBound(arrResultsRows) To UBound(arrResultsRows)
For intColNum = LBound(Split(arrResultsRows(0), ";")) To UBound(Split(arrResultsRows(0), ";"))
'MsgBox intRowNum & ":" & intColNum
'If IsDate(Split(arrResultsRows(intRowNum), ";")(intColNum)) = False Then
arrResultsTable(intRowNum, intColNum) = Split(arrResultsRows(intRowNum), ";")(intColNum)
'Else
' arrResultsTable(intRowNum, intColNum) = CDate(Split(arrResultsRows(intRowNum), ";")(intColNum))
'End If
Next
Next
' ********** End of creating the main Results Table array **************
Output_To_Excel
Dim objFS
Dim objOutputFile
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objOutputFile = objFS.CreateTextFile(strOutputFile, True)
objOutputFile.Write(strInactivePCs)
objOutputFile.Close
MsgBox "InactivePCs have been recorded." & vbcrlf & "Please see " & strOutputFile & ".", vbOKOnly, "Output Finished"
'*************************************************************
Sub Output_To_Excel
Dim objExcel, objExcelWorkBook, intSheetCount
Dim strAllPrinters, intActivePCCounter
Dim intRowCounter, intColCounter
Dim intProgramCounter, intComputerProgramCount
If IsArray(arrResultsTable) = True Then
Set objExcel = CreateObject("EXCEL.APPLICATION")
objExcel.Visible = True
objExcel.WorkBooks.Add
Set objExcelWorkBook = objExcel.ActiveWorkbook
objExcelWorkBook.Activate
objExcel.DisplayAlerts = False
Do While objExcel.Sheets.Count > 1
objExcel.Sheets(1).Delete
Loop
objExcel.DisplayAlerts = True
' *************** All Printers ***************
' objExcel.Sheets(1).Name = "All Printers"
' Display_All_Printers "Excel", objExcel
' ********************************************
' *********** Individual Printers ************
For intActivePCCounter = LBound(arrActivePCs) To UBound(arrActivePCs)
objExcel.Sheets(1).Select
objExcel.Sheets.Add
objExcel.Sheets(1).Name = arrActivePCs(intActivePCCounter)
objExcel.Sheets(arrActivePCs(intActivePCCounter)).Move , objExcel.Sheets(objExcel.Sheets.Count)
objExcel.Sheets(arrActivePCs(intActivePCCounter)).Select
Next
objExcel.Sheets(1).Delete
objExcel.ScreenUpdating = False
Show_Computer_Programs objExcel
' ********************************************
objExcel.Sheets(1).Select
objExcel.ActiveSheet.Range("A1").Select
objExcel.ScreenUpdating = True
MsgBox "There were " & objExcel.Sheets.Count & " PCs inspected."
Set objExcelWorkBook = Nothing
Set objExcel = Nothing
Else
MsgBox "No programs have been retrieved. Cannot output to Excel."
End If
End Sub
'*************************************************************
Sub Write_Excel_Header_Row(objExcelApp)
Dim arrFields
Dim intColCounter, strLastColumn
arrFields = Array("Computer", "Owner", "Software", "Version")
For intColCounter = LBound(arrFields) To UBound(arrFields)
objExcelApp.ActiveSheet.Range(Chr(intColCounter + 65) & "1").FormulaR1C1 = arrFields(intColCounter)
Next
strLastColumn = Chr(UBound(arrFields) + 65)
objExcelApp.ActiveSheet.Range("A1:" & strLastColumn & "1").Font.Bold = True
objExcelApp.ActiveSheet.Range("A:" & strLastColumn).EntireColumn.AutoFit
objExcelApp.Cells.Select
objExcelApp.Selection.Sort objExcelApp.ActiveSheet.Range("C2"), 1, , , , , , 1, 1, False, 1
objExcelApp.ActiveSheet.Range("A1").Select
End Sub
'*************************************************************
Sub Show_Computer_Programs(objExcelObj)
Dim intProgramCounter, intComputerProgramCount, intRowCounter, intColCounter, intActivePCCounter
If IsArray(arrResultsTable) = True Then
For intActivePCCounter = LBound(arrActivePCs) To UBound(arrActivePCs)
intComputerProgramCount = 0
For intProgramCounter = LBound(arrResultsTable) To UBound(arrResultsTable)
'MsgBox "Table: " & arrResultsTable(intProgramCounter, 0) & " - ActivePC:" & arrActivePCs(intActivePCCounter)
If arrResultsTable(intProgramCounter, 0) = arrActivePCs(intActivePCCounter) Then
intComputerProgramCount = intComputerProgramCount + 1
End If
Next
ReDim arrComputerPrograms(intComputerProgramCount - 1, UBound(Split(arrResultsRows(0), ";")))
intRowCounter = 0
For intProgramCounter = LBound(arrResultsTable) To UBound(arrResultsTable)
If arrResultsTable(intProgramCounter, 0) = arrActivePCs(intActivePCCounter) Then
For intColCounter = LBound(Split(arrResultsRows(0), ";")) To UBound(Split(arrResultsRows(0), ";"))
arrComputerPrograms(intRowCounter, intColCounter) = arrResultsTable(intProgramCounter, intColCounter)
Next
intRowCounter = intRowCounter + 1
End If
Next
If UBound(arrComputerPrograms) > -1 Then
objExcelObj.Sheets(arrActivePCs(intActivePCCounter)).Select
Display_Single_Computer_Programs objExcelObj
Else
objExcelObj.Sheets(arrActivePCs(intActivePCCounter)).Select
Write_Excel_Header_Row objExcelObj
End If
Next
Else
MsgBox "No programs have been retrieved."
End If
End Sub
'*************************************************************
Sub Display_Single_Computer_Programs(objExcelObj)
Dim intRowCounter, intColCounter
objExcelObj.ActiveSheet.Cells.Select
objExcelObj.Selection.NumberFormat = "@"
For intRowCounter = LBound(arrComputerPrograms) To UBound(arrComputerPrograms)
For intColCounter = LBound(Split(arrResultsRows(0), ";")) To UBound(Split(arrResultsRows(0), ";"))
objExcelObj.ActiveSheet.Range(Chr(intColCounter + 65) & intRowCounter + 2).FormulaR1C1 = arrComputerPrograms(intRowCounter, intColCounter)
If InStr(arrComputerPrograms(intRowCounter, intColCounter), "<Error>") > 0 Then
objExcelObj.ActiveSheet.Range(Chr(intColCounter + 65) & intRowCounter + 2).Select
objExcelObj.Selection.Font.Bold = True
objExcelObj.Selection.Font.ColorIndex = 3
End If
Next
Next
Write_Excel_Header_Row(objExcelObj)
End Sub
'************* PING FUNCTION ********************
Function Ping(ByVal strName)
Dim objFSO, objShell, objTempFile, objTS, strTempFile
Dim strCommand, strReadLine
Dim boolReturn
Set objShell = WScript.CreateObject("Wscript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
strTempFile = strWorkingDir & "temp.txt"
'Set default return value
boolReturn = False
'Create command line to ping and save results to a temp file
strCommand = "cmd /c ping.exe -n 1 -w 500 " & strName & " > """ & strTempFile & """"
'Execute the command
objShell.Run strCommand, 0, True
'Open the temp text file
Set objTempFile = objFSO.GetFile(strTempFile)
Set objTS = objTempFile.OpenAsTextStream(1)
'Loop through the temp file to see if "reply from" is found,
'if it is then the ping was successful
Do While objTs.AtEndOfStream <> True
strReadLine = objTs.ReadLine
If InStr(LCase(strReadLine), "reply from") > 0 Then
boolReturn = True
Exit Do
End If
Loop
'Close temp file and release objects
objTS.Close
objTempFile.Delete True
Set objTS = Nothing
Set objTempFile = Nothing
Set objShell = Nothing
Set objFSO = Nothing
'Return value
Ping = boolReturn
End Function
'===================
ASKER
Hi zoofan
I just put 10 machines and ran the script
but get this message
--------------------------
--------------------------
There are no results to display. Please check that any PCs are active.
--------------------------
OK
--------------------------
I am using this script
ID: 22172631
There are no ressults or inactive files created.
I already have a similar script that gets all softwares into excel sheets that asks for a computer.txt file and gives results and inactive computers that works fine with the similar computers.
I just put 10 machines and ran the script
but get this message
--------------------------
--------------------------
There are no results to display. Please check that any PCs are active.
--------------------------
OK
--------------------------
I am using this script
ID: 22172631
There are no ressults or inactive files created.
I already have a similar script that gets all softwares into excel sheets that asks for a computer.txt file and gives results and inactive computers that works fine with the similar computers.
ASKER
Hi zoofan
I just put 10 machines and ran the script
but get this message
--------------------------
--------------------------
There are no results to display. Please check that any PCs are active.
--------------------------
OK
--------------------------
I am using this script
ID: 22172631
There are no ressults or inactive files created.
I already have a similar script that gets all softwares into excel sheets that asks for a computer.txt file and gives results and inactive computers that works fine with the similar computers.
I just put 10 machines and ran the script
but get this message
--------------------------
--------------------------
There are no results to display. Please check that any PCs are active.
--------------------------
OK
--------------------------
I am using this script
ID: 22172631
There are no ressults or inactive files created.
I already have a similar script that gets all softwares into excel sheets that asks for a computer.txt file and gives results and inactive computers that works fine with the similar computers.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Thanks Zoofan worked perfect...
Excellent, glad to here it. Thanks to Rob!!
zf
zf
Need more information.
zf
IE: even if you query every entry in the uninstall key from the registry not every app creates an entry in it.