PC上の全ユーザのOutlookプロファイルを削除するスクリプト

必要だったので作った。
VBScriptで、かなり手抜きだけど、今後のために残しておく。
ロジックは、HKEY_USERS(HKU)の下に各ユーザのハイブをロードし、 \Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles の下をごっそり削除するという単純なもの。
加えて、ログオン中のユーザのレジストリ（既にHKUにロードされているハイブ）の同エントリも削除する。

関数DeleteRegEntryはMSのKBから拝借。

' DeleteAllOutlookProfile.vbs

'Const HKEY_CLASSES_ROOT  = &H80000000
'Const HKEY_CURRENT_USER  = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKU = &H80000003

' Shell
Set shell = WScript.CreateObject("WScript.Shell")
Set env = shell.Environment("PROCESS")
WScript.Echo "env:" & env("ALLUSERSPROFILE")
ALLUSERSPROFILE = env("ALLUSERSPROFILE")

' Object used to get StdRegProv Namespace
Set wmiLocator = CreateObject("WbemScripting.SWbemLocator")

' Object used to determine local machine name
Set wshNetwork = CreateObject("WScript.Network")

' Registry Provider (StdRegProv) lives in
' root\default namespace.
Set wmiNameSpace = wmiLocator.ConnectServer(wshNetwork.ComputerName, "root\default")
Set objRegistry = wmiNameSpace.Get("StdRegProv")

' Get WMI CIMV2
set wmiService = wmiLocator.ConnectServer(wshNetwork.ComputerName, "root\cimv2")

' File System Object
Set fso = CreateObject("Scripting.FileSystemObject")

' Log File will be created in ALLUSERSPROFILE
logFilePath = ALLUSERSPROFILE & "\DeleteOutlookProfile.txt"

' Init log file
Set logFile = fso.OpenTextFile(logFilePath, 2, True)
If Err.Number <> 0 Then
 WScript.Echo("ログファイル作成失敗。")
 WScript.Quit
End If

' =====
' Write Log
' Args:
'  strLog  LogMessage
' =====
Sub WriteLog(strLog)
 On Error Resume Next
 logFile.Writeline(CStr(Now) & vbTab & strLog)
 WScript.Echo CStr(Now) & vbTab & strLog
 If Err.Number <> 0 Then
  ' Show message and quit if it failed to write log
  WScript.Echo("ログファイルの書き込みに失敗しました。")
  WScript.Quit
 End If
 On Error Goto 0
End Sub

' =====
' Delete Registry Entry Recursively
' Args:
'  sHive    Hive
'  sEnumPath   Path
' Return:
'  None
' =====
Function DeleteRegEntry(sHive, sEnumPath)
 ' Attempt to delete key.  If it fails, start the subkey
 ' enumration process.
 lRC = objRegistry.DeleteKey(sHive, sEnumPath)

 ' The deletion failed, start deleting subkeys.
 If (lRC <> 0) Then

  ' Subkey Enumerator
    On Error Resume Next

  lRC = objRegistry.EnumKey(HKU, sEnumPath, sNames)

  For Each sKeyName In sNames
   If Err.Number <> 0 Then Exit For
   lRC = DeleteRegEntry(sHive, sEnumPath & "\" & sKeyName)
  Next

  On Error Goto 0

  ' At this point we should have looped through all subkeys,
  ' trying to delete the registry key again.
  lRC = objRegistry.DeleteKey(sHive, sEnumPath)

 End If

 DeleteRegEntry = lRC

End Function

' =====
' Delete Outlook Profile Registry Key.
' Args:
'  sid  SID
'  hive  Hive
' Return:
'  None
' =====

Sub DeleteOutlookProfile(sid, hive)
 WriteLog "Sid:" & sid
 ' Get AccountName from sid
 set account = wmiService.Get("WIN32_SID.SID='" & sid & "'")
 WriteLog "AccountName:" & account.AccountName

 ' Get Outlook Profile subkey
 profile = hive & "\Software\Microsoft\Windows NT\CurrentVersion\" & _
  "Windows Messaging Subsystem\Profiles"
 objRegistry.EnumKey HKU, profile, userSubKeys

 ' Loop
 if Not IsNull(userSubKeys) then
  For Each userSubKey In userSubKeys
   WriteLog "Outlookプロファイル " & userSubKey & " を削除します。"
   WriteLog "レジストリキー: HKU" & profile & "\" & userSubKey
   ' Delete key
   result = DeleteRegEntry(HKU, profile & "\" & userSubKey)
   If result = 0 Then
    WriteLog "削除に成功しました。"
   Else
    WriteLog "削除に失敗しました。"
   End If
  Next
 Else 
  WriteLog "Outlookプロファイルが存在しませんでした。"
 End If

End Sub

' =====
' End Script.
' =====
Sub EndOfScript()
 WriteLog "処理終了"
 logFile.Close
 WScript.Quit
End Sub

' =====
' Main
' =====

' Get all userprofiles and delete Outlook profiles

' Get UserProfiles
strKeyPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList"
objRegistry.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubkeys

WriteLog "== 全ユーザのレジストリをロードし、Outlookプロファイルを削除します。 =="

' Loop
For Each objSubkey In arrSubkeys
 strValueName = "ProfileImagePath"
 strSubPath = strKeyPath & "\" & objSubkey
 objRegistry.GetExpandedStringValue HKEY_LOCAL_MACHINE, _
  strSubPath, strValueName, strValue

 ' Do if sid is domain users
 If Left(objSubKey, 8) = "S-1-5-21" Then

  ' Load Registry Hive
  writeLog "reg load HKU\hive_" & objSubKey & " """ & _
   strValue & "\NTUSER.dat"""
  shell.run "reg load HKU\hive_" & objSubKey & " """ & _
   strValue & "\NTUSER.dat""", 0, true

  ' Delete Outlook Profile
  DeleteOutlookProfile objSubKey, "hive_" & objSubKey

  ' Unload Registry Hive
  WriteLog "reg unload HKU\hive_" & objSubKey
  shell.run "reg unload HKU\hive_" & objSubKey, 0, true
  WriteLog "==================================="
   End If
Next

' Get logged-in users and delete Outlook profiles

' Get HKU Subkeys
objRegistry.EnumKey HKU, "", subKeys

WriteLog "== ログイン済みユーザのレジストリからOutlookプロファイルを削除します。 =="

' Loop
For Each subKey In subKeys

 ' Do if sid is domain users
 If Left(subKey, 8) = "S-1-5-21" and _
  Right(subKey, 8) <> "_Classes" then

  ' Delete Outlook Profile
  DeleteOutlookProfile subKey, subKey

  WriteLog "==================================="
 End If
Next

EndOfScript()