Outlook VBA - Find email addresses in Message (MaiItem) Body Text

Hi All,

I am trying to put together a sub that will go through the body text of an email, and pull out email addresses.

I found something that looked like it would do what I wanted on an Excel forum here:

MrExcel Posting by BrianB - Aug 2010

I have tried to adapt it for Outlook, but when I run the code, it doesn't work.

My adaptation is here:

'=============================================================================
'- REGULAR EXPRESSION TO EXTRACT EMAIL ADDRESS FROM A STRING
'- This will match addresses like 'abc@xyz.com' and 'abc@xyz.co.uk'
'- LOOP MailItems selected
'- Adapted from post by Brian Baulsom August 2010
'=============================================================================

Option Explicit

Sub EXTRACT_EMAIL()
    
    Dim eItem As MailItem
    Dim MyRegExp As Object
    Dim MyText As String       ' Full text string
    Dim ExtractText As String
    Dim MyPattern As String     ' string search pattern
    Dim MyMatches As Variant
    '-------------------------------------------------------------------------
    '- INITIALISE VARIABLES
    Set MyRegExp = CreateObject("VbScript.RegExp")
    MyPattern = "\b\w*@\w*\.\w*\.\w*\b|\b\w*@\w*\.\w*\b"
    '-------------------------------------------------------------------------
    '- LOOP
    For Each eItem In ActiveExplorer.Selection
        MyText = eItem.Body
        '---------------------------------------------------------------------
        '- EXECUTE REGULAR EXPRESSION
        With MyRegExp
            .Global = False      ' replace first instance only
            .Pattern = MyPattern
            .ignorecase = True
            Set MyMatches = .Execute(MyText)        ' zero based array
        End With
        '---------------------------------------------------------------------
        '- RESULT TO SHEET
        If MyMatches.Count = 0 Then
            ExtractText = "? None Found ?"
        Else
            ExtractText = MyMatches(0)
        End If
        '---------------------------------------------------------------------
        Debug.Print ExtractText
    Next eItem
    '-------------------------------------------------------------------------
    Set MyRegExp = Nothing
    MsgBox ("Done")
End Sub
'-----------------------------------------------------------------------------

Select allOpen in new window

I tested on an email that contains in the body only the following string:

"Email: alan@example.com" (without the quotes) but it cannot find the email address.

I am suspecting that maybe the RegEx could be the issue, partly because I don't understand RegEx very well!  On the other hand, maybe I have missed something more obvious.

Any ideas appreciated.

Thanks,

Alan.