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（Build 9330.2087）

编辑：我在调试时发现了一个奇怪的行为。导致问题的代码部分位于myOlExp_SelectionChange()。

当我在myOlExp_SelectionChange()中添加断点并逐步执行代码时，自动缩放在调试模式下始终有效。但是，在非调试模式下会出现同样的问题（再次单击以进行自动缩放工作）。

Answer 1

在更改Zoom级别之前，尝试在事件处理程序中使用以下调用：

Application.DoEvents()

DoEvents函数产生执行，以便操作系统可以处理其他事件。 DoEvents将控制权传递给操作系统。在操作系统处理完队列中的事件并且已发送SendKeys队列中的所有密钥后，将返回控制权。 DoEvents对于简单的事情非常有用，例如允许用户在启动后取消进程，例如搜索文件。对于长时间运行的进程，通过使用Timer或将任务委派给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

此外，您可以尝试使用计时器在调整缩放级别之前引入延迟。您可以使用SetTimer和KillTimer Windows API函数。有关详细信息，请参阅Outlook VBA - Run a code every half an hour。

Answer 2

从Outlook 2018开始，有一个选项可以保存缩放（请在状态栏中右键单击缩放百分比）

几天前，MS Outlook的Autozoom VBA代码停止工作

2 个答案: