MartyConnelly
martyconnelly at shaw.ca
Mon Mar 29 11:27:42 CST 2004
This is one way of doing some of the same things yourself from Access,
It displays the result in an IE window.
but I haven't found where all the EventCodes are defined for WMIService
'needs reference set to WMI extension library and WMI cntl library
Sub testIE()
'------------------
'http://www.microsoft.com/technet/treeview/default.asp?url=/technet/scriptcenter/logs/scrlog08.asp
'displays to IE
Dim objExplorer As Object
Dim objDocument As Object
Dim strComputer As String
Dim objWMIService As Object
Dim colLoggedEvents As Object
Dim objEvent As Object
Dim dtmDate As Variant
Dim strReturn As String
Set objExplorer = CreateObject("InternetExplorer.Application")
objExplorer.Navigate "about:blank"
objExplorer.Toolbar = 0
objExplorer.StatusBar = 0
objExplorer.Width = 800
objExplorer.Height = 570
objExplorer.Left = 0
objExplorer.Top = 0
objExplorer.Visible = 1
Do While (objExplorer.Busy)
Loop
Set objDocument = objExplorer.Document
objDocument.Open
objDocument.Writeln "<html><head><title>Automatic Updates Installation
History</title></head>"
objDocument.Writeln "<body bgcolor='white'>"
objDocument.Writeln "<table width='100%'>"
objDocument.Writeln "<tr>"
objDocument.Writeln "<td width='20%'><b>Computer Name</b></td>"
objDocument.Writeln "<td width='50%'><b>Installed Update(s)</b></td>"
objDocument.Writeln "<td width='50%'><b>Date and Time Installed</b></td>"
objDocument.Writeln "</tr>"
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
'IE Event code=19 WinXP=4377
Set colLoggedEvents = objWMIService.ExecQuery _
("SELECT * FROM Win32_NTLogEvent WHERE Logfile = 'System' AND " _
& "EventCode = '19' OR EventCode = '4377'")
Dim i As Long
For Each objEvent In colLoggedEvents
dtmDate = objEvent.TimeWritten
strReturn = WMIDateStringTodate(dtmDate)
objDocument.Writeln "<tr>"
objDocument.Writeln "<td width='20%'>" & objEvent.ComputerName & "</td>"
objDocument.Writeln "<td width='50%'>" & objEvent.Message & "</td>"
objDocument.Writeln "<td width='50%'>" & strReturn & "</td>"
objDocument.Writeln "</tr>"
i = i + 1
Next
Debug.Print "no of events=" & i
objDocument.Writeln "</table>"
objDocument.Writeln "</body></html>"
'objDocument.Write()
objDocument.Close
MsgBox "finished"
Set objExplorer = Nothing
Set objDocument = Nothing
Set objWMIService = Nothing
Set colLoggedEvents = Nothing
Set objEvent = Nothing
End Sub
Function WMIDateStringTodate(dtmDate)
WMIDateStringTodate = CDate(Mid(dtmDate, 5, 2) & "/" & _
Mid(dtmDate, 7, 2) & "/" & Left(dtmDate, 4) _
& " " & Mid(dtmDate, 9, 2) & ":" & _
Mid(dtmDate, 11, 2) & ":" & Mid(dtmDate, _
13, 2))
End Function
'or you can run this for window hotfixes
Function hotfix(Optional strComputerName = "Local") As String
Dim objWMIService As Object
Dim colItems As Object
Dim objItem As Object
Dim colQuickFixes As Object
Dim objQuickFix As Object
Dim strComputer As String
Dim strMsg As String
' Check command line parameters
Select Case strComputerName
Case "Local"
' Default if none specified is local computer (".")
Set objWMIService = GetObject("winmgmts://./root/cimv2")
Set colItems = objWMIService.ExecQuery("Select * from
Win32_ComputerSystem", , 48)
For Each objItem In colItems
strComputer = objItem.Name
Next
Case Else
' Command line parameter can either be a computer name
' or "/?" to request online help
strComputer = strComputerName
If InStr(strComputer, "?") > 0 Then Syntax
End Select
' Header line for screen output
strMsg = vbCrLf & "Hotfixes installed on " & strComputer & ":" & vbCrLf
& vbCrLf
' Enable error handling
On Error Resume Next
' Connect to specified computer
Set objWMIService =
GetObject("winmgmts:{impersonationLevel=impersonate}!//" & strComputer &
"/root/cimv2")
' Display error number and description if applicable
If Err Then ShowError
' Query hotfixes
Set colQuickFixes = objWMIService.ExecQuery("Select * from
Win32_QuickFixEngineering")
' Display error number and description if applicable
If Err Then ShowError
' Prepare display of results
For Each objQuickFix In colQuickFixes
strMsg = strMsg _
& " Description: " _
& objQuickFix.Description & vbCrLf _
& " Hot Fix ID: " _
& objQuickFix.HotFixID _
& " Installation Date: " _
& objQuickFix.InstallDate _
& " Installed By: " _
& objQuickFix.InstalledBy & vbCrLf & vbCrLf
Next
' Display results
strMsg = strMsg & vbCrLf & strMsg
hotfix = strMsg
Set objWMIService = Nothing
Set colItems = Nothing
Set objItem = Nothing
Set colQuickFixes = Nothing
Set objQuickFix = Nothing
'Done
End Function
Sub ShowError()
Dim strMsg As String
strMsg = vbCrLf & "Error # " & Err.Number & vbCrLf & _
Err.Description & vbCrLf & vbCrLf
Debug.Print strMsg
MsgBox strMsg
Syntax
End Sub
'or to display all software installed this will return a very long string
'and will overflow a text box.
Function software() As String
Dim strComputer As String
Dim objWMIService As Object
Dim colFeatures As Object
Dim objFeature As Object
Dim strMsg As String
Dim lFeatureCount As Long
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colFeatures = objWMIService.ExecQuery _
("Select * from Win32_SoftwareFeature")
strMsg = ""
lFeatureCount = 0
For Each objFeature In colFeatures
lFeatureCount = lFeatureCount + 1
Debug.Print "Accesses: " & objFeature.Accesses
Debug.Print "Attributes: " & objFeature.Attributes
Debug.Print "Caption: " & objFeature.Caption
Debug.Print "Description: " & objFeature.Description
Debug.Print "Identifying Number: " & objFeature.IdentifyingNumber
Debug.Print "Install Date: " & objFeature.InstallDate
Debug.Print "Install State: " & objFeature.InstallState
Debug.Print "LastUse: " & objFeature.LastUse
Debug.Print "Name: " & objFeature.Name
Debug.Print "ProductName: " & objFeature.ProductName
Debug.Print "Vendor: " & objFeature.Vendor
Debug.Print "Version: " & objFeature.Version
strMsg = strMsg & vbCrLf & "Accesses: " & objFeature.Accesses
strMsg = strMsg & vbCrLf & "Attributes: " & objFeature.Attributes
strMsg = strMsg & vbCrLf & "Caption: " & objFeature.Caption
strMsg = strMsg & vbCrLf & "Description: " & objFeature.Description
strMsg = strMsg & vbCrLf & "Identifying Number: " &
objFeature.IdentifyingNumber
strMsg = strMsg & vbCrLf & "Install Date: " & objFeature.InstallDate
strMsg = strMsg & vbCrLf & "Install State: " & objFeature.InstallState
strMsg = strMsg & vbCrLf & "LastUse: " & objFeature.LastUse
strMsg = strMsg & vbCrLf & "Name: " & objFeature.Name
strMsg = strMsg & vbCrLf & "ProductName: " & objFeature.ProductName
strMsg = strMsg & vbCrLf & "Vendor: " & objFeature.Vendor
strMsg = strMsg & vbCrLf & "Version: " & objFeature.Version
Next
software = strMsg
MsgBox "Software features=" & lFeatureCount
End Function
Martin Reid wrote:
>Someone was looking at finding a way to see which patches ahd been applied
>to a pc. This tool does that plus a bit more and is free for home use.
>
>http://www.belarc.com/free_download.html
>
>
>No connection to the company or the software.
>
>
>Martin
>
>
>
--
Marty Connelly
Victoria, B.C.
Canada