Forward email based on subject line

Question

I'm trying to forward emails from my company's Outlook to an email account outside of our company. I have been given the ok to do this.

I'd like to forward any email that contains "Excel Friday" in the subject line.

Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
    Dim olApp As Outlook.Application
    Dim objNS As Outlook.NameSpace
    Set olApp = Outlook.Application
    Set objNS = olApp.GetNamespace("MAPI")
    ' default local Inbox
    Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub
 
Private Sub Items_ItemAdd(ByVal Item As Object)
    On Error GoTo ErrorHandler
    Dim Msg As Outlook.MailItem
    If TypeName(Item) = "MailItem" Then
        Set Msg = Item
        If Msg.Subject = "Excel Friday" Then
            Dim myMail As Outlook.MailItem
            Set myMail = Msg.Reply
            myMail.To = "xxxxxx@fakemail.com"
            myMail.Display
        End If
    End If
ProgramExit:
    Exit Sub
ErrorHandler:
    MsgBox Err.Number & " - " & Err.Description
    Resume ProgramExit
End Sub

Answer 1

I'd like to forward any email that contains "Excel Friday" in the subject line to another email address.

But in the code you check for the exact match of the subject line:

If Msg.Subject = "Excel Friday" Then

Instead you need to look for a substring. To find the position of a substring in a string, use Instr function.

If Instr(Msg.Subject, "Excel Friday") Then

Also I have noticed that you use the Reply method:

Set myMail = Msg.Reply 

Use the Forward method instead:

Set myMail = Msg.Forward

And then use the Send method.

 myMail.Recipients.Add "Eugene Astafiev" 

 myMail.Send 

Be aware, the code is based on the ItemAdd event handler. This event is not fired when a large number of items are added to the folder at once (more than 16).

Answer 2

You can do this using a Run a Script rule

Sub ChangeSubjectForward(Item As Outlook.MailItem)
    Item.Subject = "Test"
 Item.Save

Set olForward = Item.Forward
olForward.Recipients.Add "Jasonfish11@domain.com"

olForward.Send

End Sub

If a vba you can run on all messages in a folder at any time.

Paste into ThisOutlookSession and run

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

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

For Each aItem In mail.Items
      aItem.Subject = "New Subject"
    aItem.Save

    Set olForward = aItem.Forward
    olForward.Recipients.Add "Jasonfish11@domain.com"
    olForward.Send

Next aItem
End Sub

source Link