Office 2013 Free/Busy issues

 

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

 

2 thoughts on “Office 2013 Free/Busy issues

    1. Yes, they have released a fix to the cause, however it does not fix the issue with the profile being messed up, that part you still have to fix by recreating the profile, or fixing the registry keys manually or by using just the profile repair portion of the above script.

Comments are closed.