CODEWITHSUNDEEP
regexvbaemailoutlook
BoostedMonkey
BoostedMonkey

Reputation: 134

Outlook Forwarding and Regular Expressions

I am trying to set a rule within Outlook that whenever I receive an email with a certain subject a script runs and parses through that emails body and returns a number that ranges from 4-6 characters long. For example 4444 or 123456.

Each email coming in contains only one of these numbers that ranges from 4 to 6 characters long, along with other information within the email. I want that 4 to 6 digit number returned to be in the email subject of a new email message being sent to a different address.

This is the script I have written up. 

 Sub Forward(Item As Outlook.MailItem)
    Dim M1 As MatchCollection
    Dim M As Match

    Set Reg1 = New RegExp

    With Reg1
        .Pattern = "([0-9]{4-6})"
        .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 "[email protected]"

myForward.Send
End Sub

I understand on how to create a rule to trigger for each email coming in with a specific subject, but I'm new to VBA and am having trouble with this simple task. I'm getting an object Error on "Test" and I'm not sure how to fix this problem.

Upvotes: 1

Views: 574

Answers (1)

0m3r
0m3r

Reputation: 12499

You almost got it, see example below...

Option Explicit
Public Sub Forward(Item As Outlook.MailItem)
    Dim M1 As MatchCollection
    Dim M As Match
    Dim Reg1 As Object
    Dim myForward As Object

    Set Reg1 = New RegExp

    With Reg1
        .Pattern = "([0-9]{4,6})"
        .Global = True
    End With

    If Reg1.Test(Item.Body) Then
        Set M1 = Reg1.Execute(Item.Body)
        For Each M In M1
            Debug.Print M.SubMatches(0) ' Immediate Window

            '// allows for multiple matches in the message body
            Item.Subject = M.SubMatches(0) & "; " & Item.Subject

        Next
    End If

    Item.Save

    Set myForward = Item.Forward
    myForward.Recipients.Add "[email protected]"
    myForward.Display
End Sub

Upvotes: 1

Related Questions