On November 12th Microsoft released updates for Microsoft Outlook 2013, two of these updates resulted in breaking some of the functionality within Outlook, specifically the ability to view free/busy time via the Scheduling Assistant, and the Out of Office Reply message. I won’t go into the troubleshooting that my colleagues and I went through to determine the cause as that has been well documented across many other’s blog posts. What I have is our solution to solve the issue, which you are free to use.
To start with, for the majority of our systems they get their updates from one of three different WSUS servers, a small handful of systems go directly to Microsoft to get their updates (these may be the biggest headache). Our first step has been to block the distribution of both KB2837618 and KB2837643 on all of the WSUS servers. With it no longer being distributed once we uninstall the patch it should not come back, at least not until Microsoft rolls the “fix” into another patch.
Having blocked the distribution of the offending patches we began to look into ways to uninstall the patches. Some areas chose to manually uninstall the patches which may be listed up to four times in the installed patches list, all of which need to be uninstalled. As not everyone uses the free/busy functionality, and it seems even fewer use the OOO message feature through Outlook, we have not had as many calls as we would have expected. Other support staff waited for the following complete solution to fix their systems. The first part of the script was to uninstall all of the patches.
If you search the registry for the KB number you will eventually arrive at the HKLM\SOFTWARE\Microsoft\CurrentVersion\Uninstall key and/or HKLM\SOFTWARE\Wow6432Node\Microsoft\CurrentVersion\Uninstall key(s) depending upon the bitness of the Office install. The information we are interested in is the UninstallString value for the installed patches. If you wish to not be prompted for every uninstall you cannot use this uninstall string even with added switches, the Oarpmany.exe that is referenced in the value not appear to support silent switches. But with the two GUID values stored in the string we can use MSIEXEC /package {GUID} /uninstall {GUID} to uninstall the patch.
Sample uninstall string, the first GUID is the package ID for the piece of Office that was patched, the second GUID is the patch that was applied to the package and needs to be uninstalled:
DisplayName = Security Update for Microsoft Outlook 2013 (KB2837618) 64-Bit Edition
UninstallString = “C:\Program Files\Common Files\Microsoft Shared\OFFICE15\Oarpmany.exe” /removereleaseinpatch “{90150000-0011-0000-1000-0000000FF1CE}” “{73EA8579-0D2A-4603-B156-5D29E2DF619C}” “1033” “0”
I tried using various Microsoft patch uninstall scripts from around the web but found none that worked for uninstalling the Office patches without breaking Outlook. Here is what I came up with that works:
Const HKEY_LOCAL_MACHINE = &H80000002Dim strOfficeBitness, oReg, strUninstallKey, regUninstallGUIDS, strSWGUID, regStrDisplayNameDim regStrUninstallString,objCommand, strOfficeGUID, strPatchGUID, strUninstall
‘Get the bitness of Office, since we are fixing Office we know we can use the bitness value ‘of Outlook to make this determination. oReg.GetStringValue HKEY_LOCAL_MACHINE,”SOFTWARE\Microsoft\Office\15.0\Outlook”, “Bitness”, _ strOfficeBitness ‘set our registry uninstall string to search If strOfficeBitness = “x64” Then strUninstallKey = “SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall” Else strUninstallKey = “SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall” End If oReg.EnumKey HKEY_LOCAL_MACHINE, strUninstallKey, regUninstallGUIDS
‘Search all the keys looking for the KB number in the DisplayName value, the use the GUIDs in the ‘UninstallString value to remove the patches. For Each strSWGUID in regUninstallGUIDS ‘Get the Display Name of each installed update oReg.GetStringValue HKEY_LOCAL_MACHINE, strUninstallKey & “\” & strSWGUID, “DisplayName”, _ regStrDisplayName ‘Check it for the KB numbers in the Dsiplay name If ((InStr (regStrDisplayName, “KB2837618”)>0) Or _ (InStr (regStrDisplayName, “KB2837643”)>0)) Then ‘Get the UninstallString oReg.GetStringValue HKEY_LOCAL_MACHINE,strUninstallKey & “\” &_ strSWGUID, “UninstallString”, regStrUninstallString ‘Get the Office component GUID form the UninstallString strOfficeGUID = Mid(regStrUninstallString, InStr(regStrUninstallString, “{“), 38) ‘Get the Patch GUID from the UninstallString strPatchGUID = Mid(regStrUninstallString, InStrRev(regStrUninstallString, “{“), 38) ‘Uninstall the patch, preventing potential restart strUninstall = “msiexec /package ” & strOfficeGUID & ” /uninstall ” & strPatchGUID &_ ” /qn /norestart” WScript.Echo “Uninstalling: ” & regStrDisplayName errReturn = objCommand.Run(strUninstall, 0, True) ‘Check if the patch needs a system reboot to complete If errReturn = 3010 Then NeedReboot = True ‘If not successful, exit code 0, or success and reboot needed report an error If (errReturn <> 0) and (errReturn <> 3010) Then WScript.Echo “Error: ” & errReturn & ” while uninstalling ” & Chr(13) & regStrDisplayName End If End If Next |
Once uninstalled the patches are moved to the hidden update list so that the machines not using a WSUS server will not reinstall the patches.
Dim hideupdates(1)hideupdates(0) = “KB2837618”
hideupdates(1) = “KB2837643”
set updateSession = createObject(“Microsoft.Update.Session”) set updateSearcher = updateSession.CreateupdateSearcher()
‘Get a list of updates that are not yet installed and are not already Hidden. Set searchResult = updateSearcher.Search(“IsHidden=0 and IsInstalled=0 and Type=’Software'”)
‘Search the list for the updates in the hideupdates array and set them to be hidden. For i = 0 To searchResult.Updates.Count-1 set update = searchResult.Updates.Item(i) For j = 0 To UBound(hideupdates) WScript.Echo update.Title if instr(update.Title, hideupdates(j)) = 0 Then Wscript.echo “No match” Else Wscript.echo “Hiding ” & hideupdates(j) update.IsHidden = True End If Next Next |
Once the patches have been dealt with the last piece is to fix the profile. This is the piece that was the most annoying. Microsoft in their infinite wisdom decided that all of the Outlook profile information should be stored in the registry (fine), and mostly in binary (really?). To make it even easier your Outlook profile is also in a key that as far as I have been able to determine is a randomly assigned UID not referenced anywhere else. Depending upon the configuration and the features used by a user there are a couple of values that need to be fixed inside these keys.
Now I was primarily concerned with the default outlook profile, very few of our users have multiple Exchange accounts configured. So I started by getting the default profile name from HKCU\Software\Microsoft\Office\15.0\Outlook\DefaultProfile which is Isaac on my machine but in most cases is set to Outlook. Using this information I then search all of the subkeys of HKCU\Software\Microsoft\Office\15.0\Outlook\Profiles\Isaac for the ValueName of “001e6750” that contains the profile name “Isaac”, this is the subkey that contains the primary information for the Exchange profile.
Once we have found this key we then need to read the value of the user email address, which is stored in binary. This is in the “001f3001” value, since we actually need the email address in binary to fix the issue we don’t need to convert it to readable text (thank you for minor miracles).
With the email address in hand we can now fix the value of “001e6641” which was messed up by the patch.
Since both the email and the SMTP value are stored as binary we can simply split them apart, remove the null string padding, join them back together and write the new value back to the SMTP registry value (sounds easy right?)
On Error Resume NextConst HKEY_CURRENT_USER = &H80000001
Dim arrCN, strCN, strEmailID, strTemp, binSMTPKey Dim objFSO, oReg, strWinMessSubSys, strDefaultProfile, regProfileKeys, strPersonalFoldersPst Dim strProfileKey, regBinValue, strPSTPath, strProfileName, regStrValue Dim regEmail, arrEmail, intOSVersion
Set oReg = GetObject(“winmgmts:\\.\root\default:StdRegProv”) Set objCommand = CreateObject(“WScript.Shell”) Set objWMIService = GetObject(“winmgmts:\\.\root\cimv2”) ‘Check for OS greater then 2000 intOSVersion = GetOS() If intOSVersion < “5” Then WScript.Quit End If
‘Search and fix the Outlook profile strWinMessSubSys = “Software\Microsoft\Office\15.0\Outlook” ‘Get the Default profile name oReg.GetStringValue HKEY_CURRENT_USER, strWinMessSubSys, “DefaultProfile”, strProfileName ‘Open the Defauilt profile strDefaultProfile = strWinMessSubSys & “\Profiles\” & strProfileName ‘Get all the Default profile sub keys for searching oReg.EnumKey HKEY_CURRENT_USER, strDefaultProfile, regProfileKeys For Each strProfileKey in regProfileKeys ‘Look for the profile name in the subkey oReg.GetStringValue HKEY_CURRENT_USER, strDefaultProfile & “\” &_ strProfileKey, “001e6750”, regStrValue If regStrValue = strProfileName Then ‘Get the email address binary value oReg.GetBinaryValue HKEY_CURRENT_USER,strDefaultProfile & “\” &_ strProfileKey, “001f3001″, regEmail arrEmail = Split(Bin2Str(regEmail),”@”) Get the email account name for later use strEmailID = arrEmail(0) ‘Get the SMTP value oReg.GetBinaryValue HKEY_CURRENT_USER,strDefaultProfile & “\” &_ strProfileKey, “001f6641”, regBinValue If VarType(regBinValue) And 8192 Then ‘If the SMTP value is only 5 characters (SMTP:) assume it is broken and fix it. If Len(Bin2Str(regBinValue))=5 Then ‘In order to write a binary value back to the registry we need the binary string as an array binSMTPKey = Split(Join(regBinValue, “|:”), “|:”, 10) binSMTPKey(9)=0 ‘join the SMTP: value and the regEmail value together and write back to the registry oReg.SetBinaryValue HKEY_CURRENT_USER,strDefaultProfile & “\” &_ strProfileKey, “001f6641″, Split(join(binSMTPKey,”|:”) & “|:” & join(regEmail,”|:”), “|:”) End If End If End If Next
‘…..CONTINUED in next section |
Having collected the email address from the user profile key and fixing the value there we now need to search the keys again to fix the other entries where the “001f6641” value is incorrect. However not every key that has this value is one that will need to be fixed, only the keys that also have “001e660b” and that value ends in the users account name portion of the email address needing to be repaired.
For Each strProfileKey in regProfileKeys ‘Find the ‘Microsoft Exchange Message Store’ stored in the ‘001f3006’ value of the keysoReg.GetBinaryValue HKEY_CURRENT_USER,strDefaultProfile & “\” &_
strProfileKey, “001f3006”, regBinValue ‘If ‘001f3006’ is found in a key continue If Not IsNull(regBinValue) Then ‘Convert the value to a string so we can verify we have the ‘Microsoft Exchange Message Store’ strTemp = Bin2Str(regBinValue) If InStr (“Microsoft Exchange Message Store”, strTemp, vbTextCompare) Then ‘Read the Exchange group string oReg.GetStringValue HKEY_CURRENT_USER, strDefaultProfile & “\” &_ strProfileKey, “001e660b”, regStrValue If Not IsNull(regBinValue) Then arrCN = Split(regStrValue, “=”) ‘Get the last piece of the string after the split, the account name strCN = arrCN(UBound(arrCN)) If strEmailID = strCN Then ‘Fix the SMTP value as we did for the profile oReg.GetBinaryValue HKEY_CURRENT_USER,strDefaultProfile & “\” &_ strProfileKey, “001f6641”, regBinValue If VarType(regBinValue) And 8192 Then If Len(Bin2Str(regBinValue))=5 Then binSMTPKey = Split(Join(regBinValue, “|:”), “|:”, 10) binSMTPKey(9)=0 oReg.SetBinaryValue HKEY_CURRENT_USER,strDefaultProfile & “\” &_ strProfileKey, “001f6641″, Split(join(binSMTPKey,”|:”) & “|:” &_ join(regEmail,”|:”), “|:”) End If End If End If End If End If End If Next
MsgBox “Finished”
‘convert the binary stored string to a regular string Function Bin2Str(ByVal aBin) Dim iChr For Each iChr in aBin If iChr Then Bin2Str = Bin2Str & Chr(iChr) Next End Function
‘get the OS version number Function GetOS() Set colOperatingSystems = objWMIService.ExecQuery(“Select * from Win32_OperatingSystem”) For Each objOperatingSystem in colOperatingSystems GetOS = objOperatingSystem.Version Next End Function |
The only thing left is to put it all together, set it up to run with admin rights to make it easier for staff to run and run it under the cscript environment so displaying messages is easier.
If Not WScript.Arguments.Named.Exists(“elevate”) ThenCreateObject(“Shell.Application”).ShellExecute “cmd.exe”, ” /k ” &_
replace(WScript.FullName, “wscript”, “cscript”, 1, -1, vbTextCompare) & ” //I ” &_ chr(34) & WScript.ScriptFullName & Chr(34) & ” /elevate”, “”, “runas”, 1 WScript.Quit End If
On Error Resume Next
Const HKEY_CURRENT_USER = &H80000001 Const HKEY_LOCAL_MACHINE = &H80000002 Dim arrCN, strCN, strEmailID, strTemp, binSMTPKey, intOSVersion Dim objFSO, oReg, strWinMessSubSys, strDefaultProfile, regProfileKeys Dim strPersonalFoldersPst, regEmail, arrEmail, regStrUninstallString Dim strProfileKey, regBinValue, strPSTPath, strProfileName, regStrValue Dim strUninstallKey, regUninstallGUIDS, strSWGUID, regStrDisplayName Dim strOfficeGUID, strPatchGUID, strUninstall, strOfficeBitness Dim NeedReboot NeedReboot = False Dim hideupdates(1) hideupdates(0) = “KB2837618” hideupdates(1) = “KB2837643” Set oReg = GetObject(“winmgmts:\\.\root\default:StdRegProv”) Set objCommand = CreateObject(“WScript.Shell”) Set objWMIService = GetObject(“winmgmts:\\.\root\cimv2”) Set colItems = objWMIService.ExecQuery (“Select * From Win32_Process Where Name = ‘outlook.exe'”)
If colItems.Count <> 0 Then MsgBox “Please close Outlook” WScript.Quit 1 End If intOSVersion = GetOS() If intOSVersion < “5” Then WScript.Quit 2 End If oReg.GetStringValue HKEY_LOCAL_MACHINE,”SOFTWARE\Microsoft\Office\15.0\Outlook”, _ “Bitness”, strOfficeBitness If strOfficeBitness = “x64” Then strUninstallKey = “SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall” Else strUninstallKey = “SOFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall” End If oReg.EnumKey HKEY_LOCAL_MACHINE, strUninstallKey, regUninstallGUIDS For Each strSWGUID in regUninstallGUIDS oReg.GetStringValue HKEY_LOCAL_MACHINE, strUninstallKey & “\” & strSWGUID, _ “DisplayName”, regStrDisplayName If ((InStr (regStrDisplayName, “KB2837618”)>0) Or (InStr (regStrDisplayName, “KB2837643”)>0)) Then oReg.GetStringValue HKEY_LOCAL_MACHINE,strUninstallKey & “\” &_ strSWGUID, “UninstallString”, regStrUninstallString strOfficeGUID = Mid(regStrUninstallString, InStr(regStrUninstallString, “{“), 38) strPatchGUID = Mid(regStrUninstallString, InStrRev(regStrUninstallString, “{“), 38) strUninstall = “msiexec /package ” & strOfficeGUID & ” /uninstall ” & strPatchGUID &_ ” /qn /norestart” ‘strUninstall = “msiexec /x ” & strOfficeGUID & ” MSIPATCHREMOVE=” & strPatchGUID &_ ” /qn /norestart” ‘WScript.Echo “Running command: ” & strUninstall WScript.Echo “Uninstalling: ” & regStrDisplayName errReturn = objCommand.Run(strUninstall, 0, True) If errReturn = 3010 Then NeedReboot = True If (errReturn <> 0) and (errReturn <> 3010) Then WScript.Echo “Error: ” & errReturn & ” while uninstalling ” & Chr(13) & regStrDisplayName &_ Chr(13) & “See: http://msdn.microsoft.com/en-us/library/aa376931(v=vs.85).aspx” End If End If Next
set updateSession = createObject(“Microsoft.Update.Session”) set updateSearcher = updateSession.CreateupdateSearcher() Set searchResult = updateSearcher.Search(“IsHidden=0 and IsInstalled=0 and Type=’Software'”)
For i = 0 To searchResult.Updates.Count-1 set update = searchResult.Updates.Item(i) For j = 0 To UBound(hideupdates) ‘MsgBox hideupdates(j) ‘WScript.Echo update.Title if instr(update.Title, hideupdates(j)) <> 0 Then Wscript.echo “Hiding: ” & update.Title update.IsHidden = True end If Next Next
strWinMessSubSys = “Software\Microsoft\Office\15.0\Outlook” oReg.GetStringValue HKEY_CURRENT_USER, strWinMessSubSys, “DefaultProfile”, strProfileName strDefaultProfile = strWinMessSubSys & “\Profiles\” & strProfileName oReg.EnumKey HKEY_CURRENT_USER, strDefaultProfile, regProfileKeys For Each strProfileKey in regProfileKeys oReg.GetStringValue HKEY_CURRENT_USER, strDefaultProfile & “\” &_ strProfileKey, “001e6750”, regStrValue If regStrValue = strProfileName Then oReg.GetBinaryValue HKEY_CURRENT_USER,strDefaultProfile & “\” &_ strProfileKey, “001f3001″, regEmail arrEmail = Split(Bin2Str(regEmail),”@”) strEmailID = arrEmail(0) oReg.GetBinaryValue HKEY_CURRENT_USER,strDefaultProfile & “\” &_ strProfileKey, “001f6641”, regBinValue If VarType(regBinValue) And 8192 Then If Len(Bin2Str(regBinValue))=5 Then binSMTPKey = Split(Join(regBinValue, “|:”), “|:”, 10) binSMTPKey(9)=0 oReg.SetBinaryValue HKEY_CURRENT_USER,strDefaultProfile & “\” &_ strProfileKey, “001f6641″, Split(join(binSMTPKey,”|:”) & “|:” & join(regEmail,”|:”), “|:”) End If End If End If Next
For Each strProfileKey in regProfileKeys oReg.GetBinaryValue HKEY_CURRENT_USER,strDefaultProfile & “\” &_ strProfileKey, “001f3006”, regBinValue If Not IsNull(regBinValue) Then strTemp = Bin2Str(regBinValue) If InStr (“Microsoft Exchange Message Store”, strTemp, vbTextCompare) Then oReg.GetStringValue HKEY_CURRENT_USER, strDefaultProfile & “\” &_ strProfileKey, “001e660b”, regStrValue If Not IsNull(regBinValue) Then arrCN = Split(regStrValue, “=”) strCN = arrCN(UBound(arrCN)) If strEmailID = strCN Then oReg.GetBinaryValue HKEY_CURRENT_USER,strDefaultProfile & “\” &_ strProfileKey, “001f6641”, regBinValue If VarType(regBinValue) And 8192 Then If Len(Bin2Str(regBinValue))=5 Then binSMTPKey = Split(Join(regBinValue, “|:”), “|:”, 10) binSMTPKey(9)=0 oReg.SetBinaryValue HKEY_CURRENT_USER,strDefaultProfile & “\” &_ strProfileKey, “001f6641″, Split(join(binSMTPKey,”|:”) & “|:” &_ join(regEmail,”|:”), “|:”) End If End If End If End If End If End If Next
Function Bin2Str(ByVal aBin) Dim iChr For Each iChr in aBin If iChr Then Bin2Str = Bin2Str & Chr(iChr) Next End Function
Function GetOS() Set colOperatingSystems = objWMIService.ExecQuery(“Select * from Win32_OperatingSystem”) For Each objOperatingSystem in colOperatingSystems GetOS = objOperatingSystem.Version Next End Function
if NeedReboot then MsgBox “Repair finish, reboot needed” else MsgBox “Repair Finished” end if |