VBScript

Windows Updateの更新履歴をCSV(UTF-8)で保存するVBScript

以前書いたスクリプトが出てきました。
Windows Updateの更新履歴を

“更新日時”,”コンピューター名”,”ユーザー名”,”タイトル”,”KB番号”,”結果”

といった形式のCSVファイルとして出力するスクリプトです。

Option Explicit

Dim dir_path, cn, ymd

dir_path = "" 'CSVファイルの出力先指定

If Len(Trim(dir_path)) < 1 Then _
   dir_path = CreateObject("Scripting.FileSystemObject").GetParentFolderName(WScript.ScriptFullName)
dir_path = AddPathSeparator(dir_path)

cn = CreateObject("WScript.Network").ComputerName
ymd = Year(Now()) & Right("0" & Month(Now()), 2) & Right("0" & Day(Now()), 2)
OutputMSUpdateInfo dir_path & ymd & "_MSUP_" & cn & ".csv"

Public Sub OutputMSUpdateInfo(ByVal TxtFilePath)
'Windows Updateの更新履歴をCSV(UTF-8)で保存
  Dim str
  Const adTypeText = 2
  Const adSaveCreateOverWrite = 2
  
  str = GetMSUpdateInfo
  If Len(Trim(str)) > 0 Then
    With CreateObject("ADODB.Stream")
      .Type = adTypeText
      .Charset = "UTF-8"
      .Open
      .WriteText str
      .SaveToFile TxtFilePath, adSaveCreateOverWrite
      .Close
    End With
  End If
End Sub

Private Function GetMSUpdateInfo()
'Windows Updateの更新履歴取得
  Dim us 'WUApiLib.UpdateSession
  Dim sr 'WUApiLib.UpdateSearcher
  Dim uhec 'WUApiLib.IUpdateHistoryEntryCollection
  Dim uhe 'WUApiLib.IUpdateHistoryEntry
  Dim rs
  Dim kb, rc
  Dim cn, un
  Dim cnt
  Dim ret
  Const adVarChar = 200
  Const adDBTimeStamp = 135
  
  Set us = CreateObject("Microsoft.Update.Session")
  Set sr = us.CreateUpdateSearcher
  
  cnt = sr.GetTotalHistoryCount
  If cnt < 1 Then Exit Function
  
  'コンピューター名とユーザー名取得
  With CreateObject("WScript.Network")
    cn = .ComputerName
    un = .UserName
  End With
  
  'レコードセット設定
  Set rs = CreateObject("ADODB.Recordset")
  rs.Fields.Append "Date", adDBTimeStamp, 255
  rs.Fields.Append "ComputerName", adVarChar, 255
  rs.Fields.Append "UserName", adVarChar, 255
  rs.Fields.Append "Title", adVarChar, 255
  rs.Fields.Append "KB", adVarChar, 255
  rs.Fields.Append "Result", adVarChar, 255
  rs.Open
  
  Set uhec = sr.QueryHistory(0, cnt)
  For Each uhe In uhec
    kb = UCase(uhe.Title)
    If InStr(kb, "KB") Then
      kb = Mid(kb, InStr(kb, "KB"))
      kb = Left(kb, InStr(kb, ")") - 1)
    Else
      kb = ""
    End If
    
    'OperationResultCode enumeration
    'https://msdn.microsoft.com/en-us/library/windows/desktop/aa387095.aspx
    Select Case uhe.ResultCode
      Case 0: rc = "NotStarted"
      Case 1: rc = "InProgress"
      Case 2: rc = "Succeeded"
      Case 3: rc = "SucceededWithErrors"
      Case 4: rc = "Failed"
      Case 5: rc = "Aborted"
      Case Else: rc = ""
    End Select
    
    rs.AddNew
    rs.Fields("Date").Value = uhe.Date
    rs.Fields("ComputerName").Value = cn
    rs.Fields("UserName").Value = un
    rs.Fields("Title").Value = uhe.Title
    rs.Fields("KB").Value = kb
    rs.Fields("Result").Value = rc
    rs.Update
  Next
  rs.Sort = "Date DESC" '日付で降順ソート
  rs.MoveFirst
  Do Until rs.EOF
    ret = ret & _
          ChrW(34) & rs.Fields("Date").Value & ChrW(34) & ChrW(44) & _
          ChrW(34) & rs.Fields("ComputerName").Value & ChrW(34) & ChrW(44) & _
          ChrW(34) & rs.Fields("UserName").Value & ChrW(34) & ChrW(44) & _
          ChrW(34) & rs.Fields("Title").Value & ChrW(34) & ChrW(44) & _
          ChrW(34) & rs.Fields("KB").Value & ChrW(34) & ChrW(44) & _
          ChrW(34) & rs.Fields("Result").Value & ChrW(34) & vbNewLine
    rs.MoveNext
  Loop
  rs.Close
  ret = Left(ret, InStrRev(ret, vbNewLine) - 1) '最後の改行削除
  GetMSUpdateInfo = ret
End Function

Private Function AddPathSeparator(ByVal s)
  If Right(s, 1) <> ChrW(92) Then s = s & ChrW(92)
  AddPathSeparator = s
End Function

多数の端末のWindows Update履歴を、一台一台確認するのが面倒くさかったので書いたような記憶があります。

VBScriptからのWindows Updateの取り扱いについては下記Webページに詳しくまとめられているので、興味がある方はそちらをご参照ください。

コメント

  • コメント (0)

  • トラックバックは利用できません。

  1. この記事へのコメントはありません。

Time limit is exhausted. Please reload CAPTCHA.

おすすめ記事

アーカイブ

RapidSSL_SEAL-90x50
PAGE TOP