1
votes

I have used the following code in Outlook 2010 successfully:

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("[email protected]")
        ' for testing only -- Set objMe = Item.Recipients.Add("[email protected]")
        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

I have recently switched to Outlook 2013. It offers the option to hit reply and have the new reply window be docked right in the message list. However, if I reply that way my code fails at this line:

Set myItem = Application.ActiveInspector.CurrentItem

If I open up the message by double-clicking so it is not docked to the message list, the code runs just fine.

1

1 Answers

5
votes

Here is what worked for me. The following function returns an Outlook.MailItem message object for the message the user is looking at, whether it is a docked reply or a message in its own window. If it can't find an open message, then it will return Nothing. The key to the whole thing is the Application.ActiveExplorer.ActiveInlineResponse property, which is new in Outlook 2013. You will have to add some code to avoid attempting to call ActiveInlineResponse if you are running an older version of 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

Let me know if it works for you!