Code For Excel And Outlook Blog

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:

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:

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  |   Subscribe to Posts Feed  |   Subscribe to Comments

Filed Under: Outlook, VBA, automation
Tags: automation, events, forward, Outlook, VBA