Autozoom email window using myOlExp_SelectionChange with single click - vba

Question

I have code that auto-zooms the email window pane. It worked until a few days ago after the latest update was made to MS Outlook.
'Install redemption and add "Microsoft Word Object Library" reference and "Redemption Outlook library" reference.
Option Explicit
Dim WithEvents objInspectors As Outlook.Inspectors
Dim WithEvents objOpenInspector As Outlook.Inspector
Dim WithEvents objMailItem As Outlook.MailItem
Dim WithEvents myOlExp As Outlook.Explorer
Dim sExplorer As Object
Dim Document As Object
Dim Msg
Const MsgZoom = 150
Private Sub Application_Startup()
Set objInspectors = Application.Inspectors
Set myOlExp = Application.ActiveExplorer
Set sExplorer = CreateObject("Redemption.SafeExplorer")
End Sub
Private Sub Application_Quit()
Set objOpenInspector = Nothing
Set objInspectors = Nothing
Set objMailItem = Nothing
End Sub
Private Sub objInspectors_NewInspector(ByVal Inspector As Inspector)
If Inspector.CurrentItem.Class = olMail Then
Set objMailItem = Inspector.CurrentItem
Set objOpenInspector = Inspector
End If
End Sub
Private Sub objOpenInspector_Close()
Set objMailItem = Nothing
End Sub
Private Sub objOpenInspector_Activate()
Dim wdDoc As Word.Document
Set wdDoc = objOpenInspector.WordEditor
wdDoc.Windows(1).Panes(1).View.Zoom.Percentage = MsgZoom
End Sub
Private Sub myOlExp_SelectionChange()
On Error GoTo ErrHandler:
Set Msg = Application.ActiveExplorer.Selection(1)
Application.ActiveExplorer.RemoveFromSelection (Msg)
Application.ActiveExplorer.AddToSelection (Msg)
sExplorer.Item = Application.ActiveExplorer
Set Document = sExplorer.ReadingPane.WordEditor
Document.Windows.Item(1).View.Zoom.Percentage = MsgZoom
Exit Sub
ErrHandler:
Exit Sub
End Sub
I have to click on the email, then click it again to get the auto-zoom to work. In the past, I clicked on the email once.
I am using Microsoft Outlook 2016 version 1805 (Build 9330.2087)
The code section that cause the problem is in myOlExp_SelectionChange().
Auto-zooming works in debugging mode when I add a breakpoint in myOlExp_SelectionChange() and step through the code.

Answer 1

Try to use the following call in the event handler before changing the Zoom level:
Application.DoEvents()
The DoEvents function yields execution so that the operating system can process other events. DoEvents passes control to the operating system. Control is returned after the operating system has finished processing the events in its queue and all keys in the SendKeys queue have been sent. DoEvents is most useful for simple things like allowing a user to cancel a process after it has started, for example a search for a file. For long-running processes, yielding the processor is better accomplished by using a Timer or delegating the task to an ActiveX EXE component. In the latter case, the task can continue completely independent of your application, and the operating system takes care of multitasking and time slicing. Any time you temporarily yield the processor within an event procedure, make sure the procedure is not executed again from a different part of your code before the first call returns; this could cause unpredictable results.
Private Sub myOlExp_SelectionChange()
DoEvents
Set Msg = Application.ActiveExplorer.Selection(1)
Application.ActiveExplorer.RemoveFromSelection (Msg)
Application.ActiveExplorer.AddToSelection (Msg)
sExplorer.Item = Application.ActiveExplorer
Set Document = sExplorer.ReadingPane.WordEditor
Document.Windows.Item(1).View.Zoom.Percentage = MsgZoom
End Sub
Also you may try to use a timer for introducing a delay before adjusting the Zoom level. You can use the SetTimer and KillTimer Windows API functions. See Outlook VBA - Run a code every half an hour for more information.

Answer 2

In outlook 2018 onwards, there is an option to save the zoom (please right click on the zoom percentage in the status bar)