| |
ploosie
Posts: 43
Score: 0
Joined: 3/2/2008
Status: offline
|
How can I output my results to Excel instead of using a message box? Your help would be greatly appreciated.
Option Explicit
dim wshShell
Set wshShell = WScript.CreateObject("WScript.Shell")
Dim strSubKey
Dim arrSubKeys()
Dim strDisplayName, strDisplayVersion, strInstallLocation
Const HKEY_LOCAL_MACHINE = &H80000002
Const strKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"
Dim objWMIService, colitems, Item, objItem, strDescription, strPatch
Dim strComputer, message
Dim MCount, MBoxes
MCount = 0
MBoxes = 0
Dim MArray
MArray = Array()
If WScript.Arguments.Count =1 Then
strComputer = WScript.Arguments(0)
Else
strComputer = wshShell.ExpandEnvironmentStrings("%COMPUTERNAME%")
strComputer = Inputbox("Enter Computer name","WMI Patch Check",strComputer)
End If
If strcomputer = "" Then WScript.Quit
strcomputer = UCase(strComputer)
GetPatches()
AddALine "(Done!)" 'Don't change. Forces last bit to be written to Array
Dim i
For i = 0 To UBound(MArray)
MsgBox MArray(i),vbokonly + vbinformation,"Patches on " & strComputer & " (Page " & i +1 & ")"
Next
'Functions and Subs
Function GetPatches()
On Error Resume Next
AddALine "From QuickFixEngineering" & vbcrlf & vbcrlf
WMIConnect "\root\cimv2"
Set colItems = objWMIService.ExecQuery("Select * from Win32_QuickFixEngineering",,48)
For Each objItem in colitems
If Err <> 0 Then
'probably an old NT 4 box without current WMI, or security problem
MsgBox "No patches found, or WMI Error enumerating data from " & strComputer, vbcritical & vbokonly,"Error"
WScript.Quit
End If
If (objItem.Description) = "" Then
strDescription = "(No Description Available)"
Else
strDescription = objItem.Description
End If
If InStr(objItem.HotFixID,"File")= 0 Then
strPatch = objItem.HotFixID & " - " & strDescription
AddALine strPatch & vbcrlf
End If
Next
'Add Remove
WMIConnect "\root\default"
Dim objRegistry
set objRegistry = objWMIService.Get("StdRegProv")
objRegistry.EnumKey HKEY_LOCAL_MACHINE, strKey, arrSubKeys
AddALine vbcrlf & "From Add or Remove Programs:" & vbcrlf & vbcrlf
For Each strSubKey In arrSubKeys
if instr(lcase(strSubkey),"update") > 0 then
objRegistry.GetStringValue HKEY_LOCAL_MACHINE, _
strKey & "\" & strSubKey, "DisplayName", strDisplayName
AddALine strSubKey & " - " & strDisplayName & vbcrlf
strDisplayName = vbEmpty
End If
Next
End Function
Function MYOSVer()
Const SPKey = "HKLM\Software\Microsoft\Windows NT\CurrentVersion\CurrentVersion"
MyOSVER = WshShell.RegRead (SPkey)
End Function
Function AddALine(NewItem)
If NewItem = "(Done!)" Then
Redim Preserve MArray(Ubound(Marray) + 1)
message = message & vbcrlf & "(Done!)"
MArray(MBoxes) = message
Exit Function
End If
If MCount = 15 Then
Redim Preserve MArray(Ubound(Marray) + 1)
message = message & vbcrlf & "(Message Box Full. More follows.)"
MArray(MBoxes) = message
message = NewItem
MBoxes = MBoxes +1 'Increment counter for Array
MCount = 0 'Reset
Else
message = message & NewItem
MCount = MCount +1
End If
End Function
Function WMIConnect(root)
On Error Resume Next
If MYOSVer < 5.1 Then ' too bad. Must risk hanging WMI calls
Set objWMIService = GetObject("winmgmts:\\" & strComputer & root)
Else
Const wbemConnectFlagUseMaxWait = 128
Dim objLocator
Set objLocator = CreateObject("WbemScripting.SWbemLocator")
Set objWMIService = objLocator.ConnectServer(strComputer,root,,,,, wbemConnectFlagUseMaxWait)
End If
If Err.Number <> 0 Then
MsgBox "WMI Error Reaching or connecting to " & strComputer, vbcritical & vbokonly,"Error"
WScript.Quit
End If
On Error goto 0
End function
|
|
Printable Version
Adding results to Excel - 
RE: Adding results to Excel - 
New Messages
No New Messages
Hot Topic w/ New Messages
Hot Topic w/o New Messages
Locked w/ New Messages
Locked w/o New Messages
Post New Thread