A visitor to our Outlook Forums wanted to know how to change a subject and forward a message using rules:

I want to create a rule that I can run on a folder containing a number of messages that forwards each message to a new email address (a dropbox for a database). I need to write my own subject line, so that the database will read the subject line and then know to parse the document and extract the required information.

You can do this using either VBA or a Run a Script rule. If you using a rule to move the messages to another folder, the run a script rule is probably the best and can easily forward mail meeting specific conditions. You can run the rule as messages arrive or run it on the messages in the folder at any time using Run Rules Now.

Outlook 2003 users will receive the dreaded "something is trying to access your address book. Allow?" message. To avoid this, install ClickYes or Mapilab's Advanced Security software. Both are free. Mapilab's product will bypass the dialog (after you OK it the very first time), while ClickYes does the clicking for you.

Run a Script Rule

Press Alt+F11 to open the VB Editor and paste the following code into ThisOutlookSession. Create the rule in Outlook and select the script.

Don't forget to change the subject and email address!

Sub ChangeSubjectForward(Item As Outlook.MailItem)
    Item.Subject = "Test"
 Item.Save
 
Set myForward = Item.Forward
myForward.Recipients.Add "alias@domain.com"

myForward.Send

End Sub

To Delete the Sent Copy of the Message

To delete (or not save) the sent copy after it is forwarded, use myForward.DeleteAfterSubmit = True before the Send command.

Sub ChangeSubjectForward(Item As Outlook.MailItem)

Set myForward = Item.Forward
myForward.Recipients.Add "alias@domain.com"

' To BCC an address or DL, try this:
'myForward.BCC = "alias"

myForward.DeleteAfterSubmit = True

myForward.Send

End Sub

Find a code in the message body, then forward

This example combines the first script above with the macro at Use RegEx to extract text from an Outlook email message to look for a tracking code in the message body, then forward the message and include the code in the message subject.

Sub CodeSubjectForward(Item As Outlook.MailItem)

' Set reference to VB Script library
' Microsoft VBScript Regular Expressions 5.5

    Dim M1 As MatchCollection
    Dim M As Match
    
    Set Reg1 = New RegExp
        
    With Reg1
        .Pattern = "(Tracking Code\s*(\w*)\s*)"
        .Global = True
    End With
    If Reg1.Test(Item.Body) Then
    
        Set M1 = Reg1.Execute(Item.Body)
        For Each M In M1
        
'allows for multiple matches in the message body
        Item.Subject = M.SubMatches(1) & "; " & Item.Subject
        
        Next
    End If

 Item.Save
  
Set myForward = Item.Forward
myForward.Recipients.Add "alias@domain.com"
 
myForward.Send
 
End Sub

Forward Attachment & Change Subject

This version of the run a script macro gets the attachment name and puts it in the subject field. If there are multiple attachments, it exits the macro after the first matching attachment (and Excel file in this sample).

Sub ChangeSubjectForwardAttachment(Item As Outlook.MailItem)
Dim oAtt As Attachment
strAtt = ""
For Each oAtt In Item.Attachments
Debug.Print oAtt.FileName

If Right(oAtt.FileName, 5) = ".xlsx" Then

  Set myforward = Item.Forward
   myforward.Recipients.Add "alias@domain.com"
   myforward.Subject = oAtt.FileName
   myforward.Display 'Send
   Exit Sub

End If
Next oAtt

End Sub

Forward from another account

This script will forward the message from a different email account. As written, it will send from the second account in the Account list in File > Account Settings > Account Settings, under Email accounts. Change the number as needed.

myForward.SendUsingAccount = olNS.Accounts.Item(2)

Sub ChangeAccountForward(Item As Outlook.MailItem)
Dim olNS As Outlook.NameSpace
Set olNS = Application.GetNamespace("MAPI")

Set myForward = Item.Forward

myForward.Recipients.Add "alias@domain.com"
myForward.SendUsingAccount = olNS.Accounts.Item(2)
 
myForward.Send

Set olNS = Nothing
End Sub

"Change subject then forward" VBA Macro version

If you prefer a macro you can run on all messages in a folder at any time, use this code sample. This macro was put together using the script above and the code sample at Add a file number or keyword to the subject line of messages.

To use, paste into ThisOutlookSession and run, or add to a toolbar, ribbon, or QAT button.

Don't forget to change the subject and email address.

Sub ChangeSubjectThenSend()
Dim myolApp As Outlook.Application
Dim aItem As Object

Set myolApp = CreateObject("Outlook.Application")
Set mail = myolApp.ActiveExplorer.CurrentFolder

For Each aItem In mail.Items
      aItem.Subject = "New Subject"
    aItem.Save
    
    Set myForward = aItem.Forward
    myForward.Recipients.Add "alias@domain.com"
    myForward.Send

Next aItem
End Sub

Forward messages in a quarantine mailbox

This macro forwards messages that were sent to a quarantine folder by antispam software back to the original recipient. The original subject is restored.

To use, add the macro to the ribbon or toolbar. Select the message and click the button.

Use myForward.Send to automatically send the message.

You need to set a reference to the VB Script library:
Microsoft VBScript Regular Expressions 5.5 in the VB Editor's Tools, References menu.

Sub ChangeSubjectThenForward()
Dim oItem As Outlook.MailItem
Dim strSendto, strSubject As String
Dim myForward As MailItem
  
' Set reference to VB Script library
' Microsoft VBScript Regular Expressions 5.5
    Dim Reg1 As RegExp
    Dim M1 As MatchCollection
    Dim Reg2 As RegExp
    Dim M2 As MatchCollection
    Dim M As Match
 
Set oItem = ActiveExplorer.Selection.Item(1)
Set myForward = ActiveExplorer.Selection.Item(1).Forward

 ' regex from http://slipstick.me/2k3zf
 ' check the original, not the forward
    Set Reg1 = New RegExp
    With Reg1
        .Pattern = "(To[:](.*))"
        .Global = True
    End With
    If Reg1.test(oItem.Body) Then
     
        Set M1 = Reg1.Execute(oItem.Body)
        For Each M In M1
           strSendto = M.SubMatches(1)
        Next
    End If
    
    Set Reg2 = New RegExp
    With Reg2
        .Pattern = "(Subject[:](.*))"
        .Global = True
    End With
    If Reg2.test(oItem.Body) Then
     
        Set M2 = Reg2.Execute(oItem.Body)
        For Each M In M2
           strSubject = M.SubMatches(1)
        Next
    End If

    myForward.Recipients.Add strSendto
    myForward.Subject = strSubject
    myForward.Display ' change to .send to automatically send 

End Sub

Add the sender name to a read receipt

Michal wanted to add the sender's name to a read receipt subject. Because it's a Report item and not a Message, you need to tweak the script a bit. The Reports also don't have a sender name, but you can use Regular Expressions (regex) to grab the name from the message body.

Unlike the scripts above, this script is using late-binding with the regex library. This makes the macro more portable, as you don't need to set the reference to the Regex library. If you are using multiple macros with regex, it's generally better to use early binding.

The Rule condition will be "uses the Report form" (choose Reports from Application Forms in the dialog). Note: if run script is not an option in Actions, see "Run-a-Script Rules Missing in Outlook".

Sub AddSender(Item As Outlook.ReportItem)
 
Dim Reg1 As Object 'RegExp
Dim Matches As Object 'MatchCollection
Dim Match As Object 'Match
Dim strSender As String

Set Reg1 = CreateObject("VBScript.RegExp")

Reg1.Pattern = "To[:]\s*((.*))\r"

Set Matches = Reg1.Execute(Item.Body)

For Each Match In Matches
  strSender = Match.SubMatches(1)
Next

 Item.Subject = Item.Subject & " - " &  strSender
 Item.Save
    
End Sub

Testing Run a Script Macros

Testing run a script macros tends to be a PITA, since they only run when new messages arrive or when you run the rule manually. Sending new messages takes time and using Run Rules Now with a bad script or the wrong conditions can really screw up your day.

Tip: If you need to test the rule conditions, you can't avoid using Run Rules Now but you can minimize risk if you copy messages to a new folder and run it on messages in that folder.

When you just need to test the script, you can use a simple "stub" macro that calls the script, running it on the selected message.

Sub RunScript()
Dim objApp As Outlook.Application
Dim objItem As Object ' MailItem
Set objApp = Application
Set objItem = objApp.ActiveExplorer.Selection.Item(1)

'macro name you want to run goes here
YourMacroName objItem

End Sub

First: You will need macro security set to low during testing.

To check your macro security in Outlook 2010 or 2013, go to File, Options, Trust Center and open Trust Center Settings, and change the Macro Settings. In Outlook 2007 and older, it’s at Tools, Macro Security.

After you test the macro and see that it works, you can either leave macro security set to low or sign the macro.

Open the VBA Editor by pressing Alt+F11 on your keyboard.

To put the code in a module:

1. Right click on Project1 and choose Insert > Module
2. Copy and paste the macro into the new module.

More information as well as screenshots are at How to use the VBA Editor