时间戳

首页 > 解决方案 > 通过单击使用 myOlExp_SelectionChange 自动缩放电子邮件窗口

vba - 通过单击使用 myOlExp_SelectionChange 自动缩放电子邮件窗口

问题描述

我有自动缩放电子邮件窗口窗格的代码。在对 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()当我添加断点并单步执行代码时，自动缩放在调试模式下工作。

标签： vbaoutlook

解决方案

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

您也可以尝试在调整缩放级别之前使用计时器来引入延迟。您可以使用SetTimer和KillTimerWindows API 函数。有关详细信息，请参阅Outlook VBA - 每半小时运行一次代码。

推荐阅读