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

我已在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

---

如果我双击打开邮件，使其不停靠在邮件列表中，代码运行正常。

以下是对我有效的方法。以下函数为用户正在查看的邮件返回一个

Outlook.MailItem

message对象，无论它是停靠回复还是自己窗口中的邮件。如果它找不到打开的消息，那么它将返回

Nothing

。整个过程的关键是

Application.ActiveExplorer.ActiveInlineResponse

属性，它在Outlook 2013中是新的。如果您运行的是较旧版本的Outlook，则必须添加一些代码以避免尝试调用

ActiveInlineResponse

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

---

让我知道它是否适合你

以下是对我有用的东西。以下函数为用户正在查看的邮件返回一个

Outlook.MailItem

message对象，无论它是停靠回复还是自己窗口中的邮件。如果它找不到打开的消息，那么它将返回

Nothing

。整个过程的关键是

Application.ActiveExplorer.ActiveInlineResponse

属性，它在Outlook 2013中是新的。如果您运行的是较旧版本的Outlook，则必须添加一些代码以避免尝试调用

ActiveInlineResponse

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

让我知道它是否适合你