Use RegEx to extract text from an Outlook email message

Getting text out of a message body isn't as hard as it sounds, provided there is something in the body to search on. For example, if you are looking for a tracking code in an email and it's always identified as "Tracking code:" you can use InStr, Len, Left or Right functions to find and extract the tracking code.

Or you can use Regular Expressions.

For example, to extract the UPS tracking numbers for packages sent by Amazon.com and formatted as shown in the screenshot, I need to look for the words "Carrier Tracking ID", followed by possible white space and a colon (:).

.Pattern = "(Carrier Tracking ID\s*[:]+\s*(\w*)\s*)"

This returns the next alphanumeric string, or in my example, 1Z2V37F8YW51233715. (There are two tracking numbers in the email message and both are returned.)

Use \s* to match an unknown number of white spaces (spaces, tabs, line feeds, etc)
Use \d* to match only digits
Use \w* to match alphanumeric characters, such as are used in UPS tracking codes.

To use this code sample, open the VBA Editor using Alt+F11. Right-click on Project1 and choose Insert > Module. Paste the following code into the module.
 

You'll need to set a reference to the Microsoft VBScript Regular Expressions 5.5 library in Tools, References.

Note: if VBScript Expressions 1 is selected, deselect it. You can't use both v1 and v5.5.

Don't forget, macro security needs to be set to low during testing.

Sample macros using regex are at the following links. Use Copy to Excel code sample to copy a row of text to a row of cells in Excel and Select a name in a Word document then create a Contact to create a contact from a resume or similar file.

Sub GetValueUsingRegEx()
 ' Set reference to VB Script library
 ' Microsoft VBScript Regular Expressions 5.5
 
    Dim olMail As Outlook.MailItem
    Dim Reg1 As RegExp
    Dim M1 As MatchCollection
    Dim M As Match
        
    Set olMail = Application.ActiveExplorer().Selection(1)
   ' Debug.Print olMail.Body
    
    Set Reg1 = New RegExp
    
    ' \s* = invisible spaces
    ' \d* = match digits
    ' \w* = match alphanumeric
    
    With Reg1
        .Pattern = "Carrier Tracking ID\s*[:]+\s*(\w*)\s*"
        .Global = True
    End With
    If Reg1.test(olMail.Body) Then
    
        Set M1 = Reg1.Execute(olMail.Body)
        For Each M In M1
            ' M.SubMatches(1) is the (\w*) in the pattern
            ' use M.SubMatches(2) for the second one if you have two (\w*)
            Debug.Print M.SubMatches(1)
            
        Next
    End If
    
End Sub

If we look for just the colon (.Pattern ="([:]+\s*(\w*)\s*)" ), we get just the first word in the results:

UPS
May
Standard
1Z2V37F8YW51233715
Diane

This is because (\w*) tells the code to get the next alphanumeric string, not the entire line, and strings do not include spaces.

Get two (or more) values from a message

If you need to use 2 or more patterns, you can repeat the With Reg1 through End if for each pattern or you can use Case statements.

This sample code looks for 3 patterns, creates a string and adds it to the subject field of a message.

Each case represents a different pattern. In this sample, we want just the first occurrence of each pattern; .Global = False instructs the code to stop when it finds the first match.

The data we are looking for is formatted like this:

Order ID : VBNSA-123456
Order Date: 09 AUG 2013
Total $54.65

\n at the end of the pattern matches a line break, and strSubject = Replace(strSubject, Chr(13), "") cleans any line breaks from the string.

Sub GetValueUsingRegEx()
    Dim olMail As Outlook.MailItem
    Dim Reg1 As RegExp
    Dim M1 As MatchCollection
    Dim M As Match
    Dim strSubject As String
    Dim testSubject As String
         
    Set olMail = Application.ActiveExplorer().Selection(1)
     
    Set Reg1 = New RegExp
    
For i = 1 To 3

With Reg1
    Select Case i
    Case 1
        .Pattern = "(Order ID\s[:]([\w-\s]*)\s*)\n"
        .Global = False
        
    Case 2
       .Pattern = "(Date[:]([\w-\s]*)\s*)\n"
       .Global = False
       
    Case 3
        .Pattern = "(([\d]*\.[\d]*))\s*\n"
        .Global = False
    End Select
    
End With
    
    
    If Reg1.test(olMail.Body) Then
     
        Set M1 = Reg1.Execute(olMail.Body)
        For Each M In M1
            Debug.Print M.SubMatches(1)
            strSubject = M.SubMatches(1)
            
         strSubject = Replace(strSubject, Chr(13), "")
         testSubject = testSubject & "; " & Trim(strSubject)
         Debug.Print i & testSubject
         
         Next
    End If
          
Next i

Debug.Print olMail.Subject & testSubject
olMail.Subject = olMail.Subject & testSubject
olMail.Save

Set Reg1 = Nothing
     
End Sub

Use a RegEx Function

This function allows you to use the regex in more than one macro.

If you need to use more than one pattern with the function, set the pattern in the macro regPattern = "([0-9]{4})" and use this in the function: regEx.Pattern = regPattern. Don't forget to add Dim regPattern As String at the top of the module.

Function ExtractText(Str As String) ' As String
 Dim regEx As New RegExp
 Dim NumMatches As MatchCollection
 Dim M As Match
 
'this pattern looks for 4 digits in the subject
 regEx.Pattern = "([0-9]{4})"

' use this if you need to use different patterns. 
' regEx.Pattern = regPattern

 Set NumMatches = regEx.Execute(Str)
 If NumMatches.Count = 0 Then
      ExtractText = ""
 Else
 Set M = NumMatches(0)
     ExtractText = M.SubMatches(0)
 End If
 code = ExtractText
 End Function

This simple macro shows how to use the Regex Function. If the subject matches the regex pattern (in function example, a 4-digit number), a reply is created; if it does not contain a 4 digit number, a message box comes up. To use the function with different macros, uncomment the lines containing regPattern.

Dim code As String
'Dim regPattern As String

Sub RegexTest()

Dim Item As MailItem
Set Item = Application.ActiveExplorer.Selection.Item(1)

' use this to pass a pattern to the function
'regPattern = "([0-9]{4})"

ExtractText (Item.Subject)
 
If Not code = "" Then
Set myReply = Item.Reply
myReply.Display

Else
MsgBox "The subject does not contain a 4 digit number"
End If

End Sub