Greetings,
I would like to share some code I wrote last month for a user who visited my website and asked for a macro that would look for specific text in the subject of an email and forward it to another email address (in this case, an email for a mobile device). I created two versions: a Sub procedure that could be run on demand, and Event code that would automatically (in the "hands off" spirit) forward a specially crafted email.
In this post I will show the macro you would assign to a toolbar button. If you want to add this (or any other) macro to your Outlook toolbar, check out "How to assign a macro to a toolbar button" on
this page. In the next post I will follow up with the Event code.
The toolbar code should be placed in a standard module in your Outlook VB Project.
First we check what type of window we are looking at by checking the ActiveWindow Property of the Application object; if it is an Explorer, that means we don't have any emails open, so we set an object reference to the first selected item. If it is an Inspector, we have an email or other item open for viewing, so we set an object reference to it. Of course, if there is no selected item, or no open item, the code fails with an error because we can't run it.
Sub FwdMailText()
Dim objItem As Object
Dim Msg As Outlook.MailItem
Dim NewForward As Outlook.MailItem
Dim MyFolder As Outlook.MAPIFolder
Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace
On Error Resume Next
Select Case TypeName(Application.ActiveWindow)
Case "Explorer"
Set objItem = _
Application.ActiveExplorer.Selection.item(1)
Case "Inspector"
Set objItem = _
Application.ActiveInspector.CurrentItem
End Select
On Error GoTo 0
If objItem Is Nothing Then
MsgBox "Nothing selected!", _
vbExclamation
Goto ExitProc
End If
If we made it this far, we check if our object reference is to a MailItem
by checking the Class Property for the olMail constant. If it is indeed a MailItem, we set a friendly object reference "Msg" to it. I like to use string variables that easily identify what the variable represents; similar to
Hungarian notation. That way I can spend more time worrying about what the code should do and less time guessing what each variable does every time I look at it. Fortunately, "Msg" is one of those non-reserved keywords that make it obvious.
If objItem.Class = olMail Then
Set Msg = objItem
Else
MsgBox "No message selected!", _
vbExclamation
GoTo ExitProc
End If
Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set MyFolder = olNS.GetDefaultFolder(olFolderInbox)._
Folders("Archive")
At this point we execute the Forward Method of the MailItem object,
which creates a new email message based on the original, and returns an object reference to the about-to-be-forwarded MailItem. We set up the Subject: and To: fields, and use the Subject: from the original MailItem to create the Body of the forwarded item.
After sending the message, we move the original email to the folder called "Archive" which is one level below the default Inbox (see object reference for "MyFolder").
Set NewForward = Msg.Forward
With NewForward
.Subject = "Information You Requested"
.To = "myemail@mobiledevice.com"
.Body = Right(Msg.Subject, _
Len(Msg.Subject) - InStrRev(Msg.Subject, " "))
.Send
End With
With Msg
.UnRead = False
.FlagStatus = olNoFlag
.Move MyFolder
End With
ExitProc:
Set NewForward = Nothing
Set Msg = Nothing
Set objItem = Nothing
End Sub
Here is the code in its entirety:
Sub FwdMailText()
Dim objItem As Object
Dim Msg As Outlook.MailItem
Dim NewForward As Outlook.MailItem
Dim MyFolder As Outlook.MAPIFolder
Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace
On Error Resume Next
Select Case TypeName(Application.ActiveWindow)
Case "Explorer"
Set objItem = _
Application.ActiveExplorer.Selection.item(1)
Case "Inspector"
Set objItem = _
Application.ActiveInspector.CurrentItem
End Select
On Error GoTo 0
If objItem Is Nothing Then
MsgBox "Nothing selected!", _
vbExclamation
Goto ExitProc
End If
If objItem.Class = olMail Then
Set Msg = objItem
Else
MsgBox "No message selected!", _
vbExclamation
GoTo ExitProc
End If
Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set MyFolder = olNS.GetDefaultFolder(olFolderInbox)._
Folders("Archive")
Set NewForward = Msg.Forward
With NewForward
.Subject = "Information You Requested"
.To = "myemail@mobiledevice.com"
.Body = Right(Msg.Subject, _
Len(Msg.Subject) - InStrRev(Msg.Subject, " "))
.Send
End With
With Msg
.UnRead = False
.FlagStatus = olNoFlag
.Move MyFolder
End With
ExitProc:
Set NewForward = Nothing
Set Msg = Nothing
Set objItem = Nothing
End Sub
For the Body property, I chose to include the text from the subject line (everything starting from the left all the way up to the first space) of the original item, but you can include anything you want. If you wanted to include the original message body in the forward, try this:
.Body = Msg.BodyIf you are curious about the properties and methods of the MailItem object, you can enter a new line right below "With NewForward" and type a period "." You should get a dropdown list of everything you can do with a MailItem, courtesy of
Intellisense. Once you select one, you can press F1 for assistance and sample code. This is a great way to learn about the properties of an object; just declare an object of a specific type, then start typing "
objectname." and you get that list. Just be sure you go to the Options in the VB Editor in Outlook (press Alt-F11, then go to Tools>Options) and on the Editor tab, check all the boxes in the "Code Settings" frame.
Enjoy,
JP
Labels: macro, mailitem, Outlook, typename
