Event Code for Forwarding Selected Text to Another Email Address
April 27, 2008 – 2:03 pm by JP
Here is the event code I promised for forwarding emails to another email address. It does exactly the same thing as the previous code, but since it is event code, once you place it in a class module and restart Outlook, it runs automatically without any need for you to run macros by hand.
Start by pasting the following into the ThisOutlookSession module:
1 2 3 4 5 6 7 8 | Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
Dim objNS As Outlook.NameSpace
Set objNS = GetNamespace("MAPI")
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub |
This code will set up the event handler. If you already have an Application_Startup event, simply copy and paste the inner code into it. Of course you’ll want to check that you aren’t duplicating any code; Option Explicit and a quick Debug>Compile will check for that.
The ItemAdd event will check any newly added items to the Inbox, and, if they meet the criteria we specify, a new mail item is created (via the Forward method) and sent to the email address of our choice. Then the original message is marked as read and neatly tucked away. Here is the complete code:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 | Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
Dim objNS As Outlook.NameSpace
Set objNS = GetNamespace("MAPI")
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub Items_ItemAdd(ByVal item As Object)
If item.Class = olMail Then
If Left$(item.Subject, 16) = "String to search" Then
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
Set Msg = item
Set NewForward = Msg.Forward
Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI”)
Set MyFolder = olNS.GetDefaultFolder(olFolderInbox).Folders(”Archive”)
With NewForward
.Subject = Right(Msg.Subject, Len(Msg.Subject) - InStrRev(Msg.Subject, " "))
.To = "myemail@mobiledevice.com"
.HTMLBody = ""
.Send
End With
With Msg
.UnRead = False
.FlagStatus = olNoFlag
.Move MyFolder
End With
End If
End If
ExitProc:
Set NewForward = Nothing
Set Msg = Nothing
Set olApp = Nothing
Set olNS = Nothing
Set MyFolder = Nothing
End Sub |
Paste this into the ThisOutlookSession module, save and restart Outlook to get the code to start working.
I chose some arbitrary criteria (the first 16 characters of the Subject Line), you would need to customize this for your needs.
Print This Post
|
Email This Post
|
Permalink
|
Subscribe now!
Filed Under: Outlook, VBA, automation
Tags: automation, events, forward, Outlook, VBA
This post has 48 views since April 27, 2008 – 2:03 pm.
2 Responses to “Event Code for Forwarding Selected Text to Another Email Address”
Hi,
Just read your post on the blog and the code samples that you have put up for VBA Outlook look very good.
Can you guide me about writing code to delete duplicate emails from a selected folder?
Cheers
TG
By Tarun Goel on Jun 6, 2008
Tarun,
Do you have any code written so far? Some of the code on the site can be rigged to do what you want. Just set an object reference to the folder like this:
Dim MyFolder As Outlook.MAPIFolder
Dim olNS As NameSpace
Set olNS = Application.GetNamespace(”MAPI”)
Set MyFolder = olNS.GetDefaultFolder(olFolderInbox).Folders(”Folder To Search”)
Then you would have to decide how you want to identify the emails, using the Sort method to line them up so they can be compared. Are the emails exactly the same?
Thx,
JP
By JP on Jun 7, 2008