CODEWITHSUNDEEP
vbaoutlook
dan
dan

Reputation: 3519

Working with current open email

I would like to get the active opened MailItem (whether it's a new mail or a received mail). I need to add some content to that mail when the user runs my macro. I'm using Outlook 2003 and VBA.

I found this: How do you get a reference to the mail item in the current open window in Outlook using VBA? It doesn't work however because TypeName(Application.ActiveWindow) is set to nothing. I also tried Set Mail = Application.ActiveInspector.currentItem but it doesn't work either.

There must be something I don't understand about the ActiveInspector thing.

As requested, this is the procedure/macro located in a dedicated module, called when the user click on a menu-button added in the Application_Startup() method:

Sub myMacro()
    Dim NewMail As Outlook.MailItem
    Set NewMail = Application.ActiveInspector.currentItem
End Sub

Upvotes: 17

Views: 58067

Answers (4)

IanS
IanS

Reputation: 1604

The recommended solution above works well when the new email is being composed in an ActiveInspector (pop up window), but it does not cover the situation of composing an email 'inline' (in the preview pane). For this, you could use this function:

Private Function GetCurrentEmail() As MailItem
    Dim thisMail As MailItem
    If Application.ActiveInspector Is Nothing Then
        Set thisMail = Application.ActiveExplorer.ActiveInlineResponse
    Else
        Set thisMail = Application.ActiveInspector.CurrentItem
    End If
    If thisMail Is Nothing Then Exit Function
    If thisMail.Sent Then Exit Function  'ignore sent items
    Set GetCurrentEmail = thisMail
End Function

Just sharing this here as I was stumped for ages trying to find a solution to this problem!

Upvotes: 4

Dmitry Streblechenko
Dmitry Streblechenko

Reputation: 66316

Do you mean the currently selected message? In that case you need to use Application.ActiveExplorer.Selection collection, not Application.ActiveInspector.CurrentItem.

Upvotes: 5

Restevao
Restevao

Reputation: 31

            '
            Dim myOlExp As Outlook.Explorer
            Dim myOlSel As Outlook.Selection

            Set myOlExp = Application.ActiveExplorer
            Set myOlSel = myOlExp.Selection
            'MsgBox myOlSel.item(1)


            Dim selectedFolder As Outlook.MAPIFolder
              Set selectedFolder = myOlExp.CurrentFolder
            Dim itemMessage As String
              itemMessage = "Item is unknown."


             Dim expMessage As String
             expMessage = "Your current folder is " & selectedFolder.Name & "." & vbCrLf

             If myOlSel.Count > 0 Then

                             Dim selObject As Object
                            Set selObject = myOlSel.item(1)

                            If (TypeOf selObject Is Outlook.mailItem) Then
                                Dim mailItem As Outlook.mailItem
                                Set mailItem = selObject
                                itemMessage = "The item is an e-mail message." & " The subject is " & mailItem.Subject & "."
                                mailItem.Display (False)

                            ElseIf (TypeOf selObject Is Outlook.contactItem) Then
                                Dim contactItem As Outlook.contactItem
                                Set contactItem = selObject
                                itemMessage = "The item is a contact." & " The full name is " & contactItem.Subject & "."
                                contactItem.Display (False)

                            ElseIf (TypeOf selObject Is Outlook.AppointmentItem) Then
                                Dim apptItem As Outlook.AppointmentItem
                                Set apptItem = selObject
                                itemMessage = "The item is an appointment." & apptItem.Subject & "."

                            ElseIf (TypeOf selObject Is Outlook.taskItem) Then
                                Dim taskItem As Outlook.taskItem
                                Set taskItem = selObject
                                itemMessage = "The item is a task." & " The body is " & taskItem.Body & "."
                            ElseIf (TypeOf selObject Is Outlook.meetingItem) Then
                                Dim meetingItem As Outlook.meetingItem
                                Set meetingItem = selObject
                                itemMessage = "The item is a meeting item. " & "The subject is " & meetingItem.Subject & "."
                            End If
                        End If
                        expMessage = expMessage & itemMessage
                    MsgBox (expMessage)
            End Sub

Upvotes: 3

Joshua Honig
Joshua Honig

Reputation: 13225

I don't know exactly what's wrong with your code. For one thing, though, you are not validating that a new, editable email is even open. The following proof-of-concept does exactly what I think you're looking to do: insert some text into the active email being composed. If this is not possible it displays a message box explaining why.

The portion that inserts text will only work if Word is being used as the email editor (which will ALWAYS be the case in Outlook 2010+). If it is not you will have to parse and update the Body or HTMLBody text directly.

Sub InsertText()
    Dim myText As String
    myText = "Hello world"

    Dim NewMail As MailItem, oInspector As Inspector
    Set oInspector = Application.ActiveInspector
    If oInspector Is Nothing Then
        MsgBox "No active inspector"
    Else
        Set NewMail = oInspector.CurrentItem
        If NewMail.Sent Then
            MsgBox "This is not an editable email"
        Else
            If oInspector.IsWordMail Then
                ' Hurray. We can use the rich Word object model, with access
                ' the caret and everything.
                Dim oDoc As Object, oWrdApp As Object, oSelection As Object
                Set oDoc = oInspector.WordEditor
                Set oWrdApp = oDoc.Application
                Set oSelection = oWrdApp.Selection
                oSelection.InsertAfter myText
                oSelection.Collapse 0
                Set oSelection = Nothing
                Set oWrdApp = Nothing
                Set oDoc = Nothing
            Else
                ' No object model to work with. Must manipulate raw text.
                Select Case NewMail.BodyFormat
                    Case olFormatPlain, olFormatRichText, olFormatUnspecified
                        NewMail.Body = NewMail.Body & myText
                    Case olFormatHTML
                        NewMail.HTMLBody = NewMail.HTMLBody & "<p>" & myText & "</p>"
                End Select
            End If
        End If
    End If
End Sub

Upvotes: 21

Related Questions