CODEWITHSUNDEEP
vbaoutlook
user1315789
user1315789

Reputation: 3659

Autozoom email window using myOlExp_SelectionChange with single click

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.

Upvotes: 1

Views: 383

Answers (2)

dsp0105
dsp0105

Reputation: 1

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

Upvotes: -1

Eugene Astafiev
Eugene Astafiev

Reputation: 49405

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.

Upvotes: 2

Related Questions