Event Code for Forwarding Selected Text to Another Email Address

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 = ""
        End With

    With Msg
       .UnRead = False
       .FlagStatus = olNoFlag
       .Move MyFolder
    End With
    End If
End If

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.

About JP

I'm just an average guy who writes VBA code for a living. This is my personal blog. Excel and Outlook are my thing, with a sprinkle of Access and Word here and there. Follow this space to learn more about VBA. Keep Reading »

Share This Article:

Share and bookmark this articledelicious buttonfacebook buttonlinkedin buttonstumbleupon buttontwitter button

comment bubble 19 Comment(s) on Event Code for Forwarding Selected Text to Another Email Address:

  1. Tarun Goel writes:


    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?


  2. 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?


  3. Thanks for this little gem!

    I just customised this to auto reply to anybody who sends me an email with a blank subject field and give them a bollocking!

  4. Whatever floats your boat ;)

  5. I pasted it on the VBA module, but it doesn't work. WHat should I do?

    • Can you be more specific? Did you step through the code to see where it stops? If so, which line of code causes an error?

  6. Hi JP,

    Is it possible to make a macro code in outlook that will automatically set an appointment in the calendar, base on a particular email address?
    For example: evrytime an email is address to abc@yahoo.com email it will automatically create an appointment in the calendar that says "response in 5 mins." If the user dismiss it it will pop again after 2 mins.
    Is this possible? Thanks for your help!


    • Sure, although a Task reminder is more appropriate (in my opinion). The ItemSend Event has a reference to the item being sent. You can use this event to check your outgoing messages. For example

      Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
      Dim msg As Outlook.MailItem
      Dim olapp As Outlook.Application
      Dim olns As Outlook.NameSpace
      Dim olcal As Outlook.Items
      Dim newTask As Outlook.TaskItem
      If TypeName(Item) = "MailItem" Then
        Set msg = Item
        If msg.To = "abc@yahoo.com" Then
        ' get default calendar
        Set olapp = Outlook.Application
        Set olns = olapp.GetNamespace("MAPI")
        Set olcal = olns.GetDefaultFolder(olFolderTasks).Items
        Set newTask = olcal.Add
        With newTask
          .Subject = "response in 5 mins"
          .ReminderSet = True
          .ReminderTime = Now + TimeValue("00:05:00″)
        End With
        End If
      End If
      End Sub

      See http://www.jpsoftwaretech.com/outlook-vba/etiquette-check/ for more sample code.

      • Hi JP,

        Thank you very much for your help!
        I will try this in my outlook :)
        Again, Thank you very much!!!


        • Dear JP,
          I tried the codes you suggested. These codes are for sending new mail.
          These is what I need:
          For example a person will send to the abcgroup@yahoo.com email(which is us)then it will automatically create a reminder in our outlook that we need to respond in 5 minutes and it will pop again after 2 minutes.
          Please help.
          Appreciate it very much!


  7. JP,

    I am wondering if this code can be expanded to parse an email message body before forwarding to another email.

    I have a user who would like to auto-forward some emails that have "emergency" in the subject line to a pager. The problem is that the body has more info than the pager can handle, so she would like to edit or parse out the info that she needs and forward that on. The emails are pretty much formatted the same with different body info in the middle of the email that she wants to pull out. She would like it automated for the times that she is away on vacation, the emergency emails need to still be sent. Outlook rules wizard doesn't have an option for this.

    I also have to admit that I am not too familiar with VB code, but can follow some code logic.

    Any help with this would be greatly appreciated as I have searched google for something like it, but have come up short!

    Thanks in advance!

    • Absolutely. Just change

      If Left$(item.Subject, 16) = "String to search" Then


      If Instr(item.Subject, "emergency") > 0 Then

      As far as sending when on vacation, it depends on the environment. If you can set up server side rules, you can forward the emails even when the computer is off. You won't be able to use the VBA solution, however, because it resides on the local computer and the local computer would need to be on to receive the email and process it programmatically.

      A lot of hardware devices have the ability to send SMS messages to network admins in case of trouble. You might want to talk to your admin to see if there's a better solution, because if it's a true emergency there's a way to do it.

  8. Adonpr writes:

    Is it possible to monitor a number of folders for new emails, then forward to different mailboxes depending on which folder the newmail lands in?

    Set Items = objNS.GetDefaultFolder(olFolderInbox).Items + forward to a
    Set Items = objNS.GetDefaultFolder(olFolderInbox).Folders("test") + forward to b
    etc etc

    • New mail only lands in the Inbox folder of whatever location you specify in the email account settings. So you wouldn't need to set up more than one event handler.

  9. Hi All,

    I need Macro Coding such as
    If I create any Mail or reply to any mails it should come asf
    1st mail Dev/11/0001
    2nd mail Dev/11/0002
    Here Dev is my name 11 is Month and 1 is the mail number which will get increase automatically
    If possible please assign any short cut keys for that as this may not require for all mails

    Thank You in advance

  10. Nope dear

This article is closed to any future comments.
Excel School