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
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
Do you mean the currently selected message? In that case you need to use Application.ActiveExplorer.Selection collection, not Application.ActiveInspector.CurrentItem.
'
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