AutoZoom VBA код для MS Outlook перестает работать несколько дней назад

Question

У меня есть код Outlook VBA, который автоматически увеличивает размер окна электронной почты Microsoft Outlook 2016.Раньше он работал нормально, пока несколько дней назад после последнего обновления не было сделано для 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

В настоящее время я должен нажать на электронную почту,затем щелкните по нему еще раз, чтобы получить автоматический зум для работы.В прошлом мне приходилось только один раз щелкать по электронной почте, чтобы заставить работать автоматический зум.

Я использую Microsoft Outlook 2016 версии 1805 (сборка 9330.2087)

РЕДАКТИРОВАТЬ: я нашелстранное поведение при отладке.Секция кода, которая вызывает проблему, находится в myOlExp_SelectionChange().

Автоматическое масштабирование работает все время в режиме отладки, когда я добавляю точку останова в myOlExp_SelectionChange() и пошагово выполняю код.Однако та же проблема (нажмите еще раз, чтобы включить автоматическое увеличение) происходит в режиме без отладки.

Answer 1

Попробуйте использовать следующий вызов в обработчике событий перед изменением уровня Zoom:

Application.DoEvents()

Функция DoEvents обеспечивает выполнение, чтобы операционная система могла обрабатывать другие события.DoEvents передает управление операционной системе.Управление возвращается после того, как операционная система завершила обработку событий в своей очереди, и все ключи в очереди SendKeys были отправлены.DoEvents наиболее полезен для простых вещей, таких как разрешение пользователю отменить процесс после его запуска, например, поиск файла.Для длительных процессов выход из процессора лучше выполнить с помощью таймера или делегирования задачи компоненту ActiveX EXE.В последнем случае задача может продолжаться полностью независимо от вашего приложения, а операционная система заботится о многозадачности и распределении времени.Каждый раз, когда вы временно отдаете процессор в рамках процедуры события, убедитесь, что процедура не выполняется снова из другой части вашего кода, прежде чем первый вызов вернется;Это может привести к непредсказуемым результатам.

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

Также вы можете попробовать использовать таймер для введения задержки перед настройкой уровня масштабирования.Вы можете использовать функции Windows API SetTimer и KillTimer.См. Outlook VBA - запуск кода каждые полчаса для получения дополнительной информации.