Option Explicit
'---------------------------------------------------------------------------------------
' Purpose : List the contents of the Windows updates history for this computer.
' : Does not need access to Microsoft's Windows Update website.
'---------------------------------------------------------------------------------------
Sub ListWindowsUpdates()
Dim objUpdateSession As Object
Dim intTotalHistoryCount As Integer
Dim objUpdateEntry As Object
Dim objUpdateIdentity As Object
Dim intRowNumber As Integer
Dim objUpdateSearcher As Object
Dim updateHistory
intRowNumber = 7 'Row number to start displaying data on
'UpdateSession Class
Set objUpdateSession = CreateObject("Microsoft.Update.Session")
Set objUpdateSearcher = objUpdateSession.CreateUpdateSearcher
intTotalHistoryCount = objUpdateSearcher.GetTotalHistoryCount
'QueryHistory(firstItem,lastItem)
'0=The first item to retrieve
Set updateHistory = objUpdateSearcher.QueryHistory(0, intTotalHistoryCount)
For Each objUpdateEntry In updateHistory 'Loop through all Windows updates
Cells(intRowNumber, 1) = objUpdateEntry.Title
Cells(intRowNumber, 2) = objUpdateEntry.Description
Cells(intRowNumber, 3) = objUpdateEntry.Date
Select Case objUpdateEntry.Operation 'Operation type, returns a number 1 or 2
Case 1
Cells(intRowNumber, 4) = "Installation"
Case 2
Cells(intRowNumber, 4) = "Uninstallation"
Case Else
Cells(intRowNumber, 4) = "Operation type could not be determined."
End Select
Select Case objUpdateEntry.ResultCode 'Operation result, returns a number 0 to 5
Case 0
Cells(intRowNumber, 5) = "Operation has not started."
Case 1
Cells(intRowNumber, 5) = "Operation is in progress."
Case 2
Cells(intRowNumber, 5) = "Operation completed successfully."
Case 3
Cells(intRowNumber, 5) = "Operation completed, but one or more errors occurred " & _
"during the operation and the results are potentially incomplete."
Case 4
Cells(intRowNumber, 5) = "Operation failed to complete."
Case 5
Cells(intRowNumber, 5) = "Operation was aborted."
Case Else
Cells(intRowNumber, 5) = "Operation result could not be determined."
End Select
Set objUpdateIdentity = objUpdateEntry.UpdateIdentity
Cells(intRowNumber, 6) = objUpdateIdentity.UpdateID
intRowNumber = intRowNumber + 1 'Next row number
Next
'Write titles of columns
Range("A6").Select
ActiveCell.FormulaR1C1 = "Title:"
Range("B6").Select
ActiveCell.FormulaR1C1 = "Description:"
Range("C6").Select
ActiveCell.FormulaR1C1 = "Update Application Date:"
Range("D6").Select
ActiveCell.FormulaR1C1 = "Operation Type:"
Range("E6").Select
ActiveCell.FormulaR1C1 = "Operation Result:"
Range("F6").Select
ActiveCell.FormulaR1C1 = "Update ID:"
Range("A6:F6").Select
Selection.Font.Bold = True
'Auto-fit columns so can read all text in the cells
Columns("A:A").EntireColumn.AutoFit
Columns("B:B").EntireColumn.AutoFit
Columns("C:C").EntireColumn.AutoFit
Columns("D:D").EntireColumn.AutoFit
Columns("E:E").EntireColumn.AutoFit
Columns("F:F").EntireColumn.AutoFit
'Add text wrapping to column B cells for easier reading
Columns("B:B").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
'Shrink Column width
Selection.ColumnWidth = 85
'Freeze row 6 so you can scroll down the list while the column headings
'still show
Rows("7:7").Select
ActiveWindow.FreezePanes = True
Range("A1").Select
'Clear up and free objects that have been created.
Set objUpdateSession = Nothing
Set objUpdateEntry = Nothing
Set objUpdateIdentity = Nothing
Set objUpdateSearcher = Nothing
Set updateHistory = Nothing
End Sub
|