Outlook 2013 VBA代码未看到活动回复电子邮件

Question

我成功地在Outlook 2010中使用了以下代码:

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    Dim myItem As MailItem
    Set myItem = Application.ActiveInspector.CurrentItem


    If InStr(1, myItem.Subject, "@gtd") > 0 Then
        Dim objMe As Recipient
        Set objMe = Item.Recipients.Add("mikemahony.f760c@m.evernote.com")
        ' for testing only -- Set objMe = Item.Recipients.Add("mike.mahony@outlook.com")
        objMe.Type = olBCC
        objMe.Resolve
        Set objMe = Nothing
    End If
    Set myItem = Nothing
End Sub

Sub GTDTracking()
    Dim initialSubj As String
    Dim finalSubj As String
    Dim myItem As MailItem
    Set myItem = Application.ActiveInspector.CurrentItem

    initialSubj = myItem.Subject
    finalSubj = initialSubj & " (@gtd)"
    myItem.Subject = finalSubj
End Sub

我最近切换到Outlook 2013.它提供了点击回复的选项,并将新的回复窗口停靠在消息列表中.但是,如果我以这种方式回复我的代码在此行失败:

Set myItem = Application.ActiveInspector.CurrentItem

如果我通过双击打开消息,因此它没有停靠在消息列表中,代码运行正常.

Answer 1

这对我有用.以下函数返回Outlook.MailItem用户正在查看的消息的消息对象,无论是停靠的回复还是自己窗口中的消息.如果找不到打开的消息,那么它将返回Nothing.整个事情的关键是Application.ActiveExplorer.ActiveInlineResponse属性,这是Outlook 2013中的新功能.ActiveInlineResponse如果您运行的是旧版本的Outlook,则必须添加一些代码以避免尝试调用.

Function getActiveMessage() As Outlook.MailItem

    Dim insp As Outlook.Inspector

    If TypeOf Application.ActiveWindow Is Outlook.Inspector Then
        Set insp = Application.ActiveWindow
    End If


    If insp Is Nothing Then
        Dim inline as Object
        Set inline = Application.ActiveExplorer.ActiveInlineResponse
        If inline Is Nothing Then Exit Function

        Set getActiveMessage = inline
    Else
       Set insp = Application.ActiveInspector
       If insp.CurrentItem.Class = olMail Then
          Set getActiveMessage = insp.CurrentItem
       Else
         Exit Function
       End If

    End If

End Function

请让我知道这对你有没有用!