Extract multiple email in a single Outlook message to Excel?

Question

I need a macro in Outlook that extract all the email address in the outlook message then post it in excel.

The following code only extracts the very 1st email address it finds in the body.

My desired output should be:

adam.peters@sample.com
adam.dryburgh@sample.com
amy.norton@sample.com

My sample email is:

Delivery has failed to these recipients or groups:

adam.peters@sample.com The e-mail address you entered couldn't be found. Please check the recipient's e-mail address and try to resend the message. If the problem continues, please contact your helpdesk.

adam.dryburgh@sample.com The e-mail address you entered couldn't be found. Please check the recipient's e-mail address and try to resend the message. If the problem continues, please contact your helpdesk.

amy.norton@sample.com The e-mail address you entered couldn't be found. Please check the recipient's e-mail address and try to resend the message. If the problem continues, please contact your helpdesk.

The following organization rejected your message: mx2.dlapiper.iphmx.com.

code:

Sub Extract_Invalid_To_Excel()

Dim olApp As Outlook.Application    
Dim olExp As Outlook.Explorer    
Dim olFolder As Outlook.MAPIFolder    
Dim obj As Object    
Dim stremBody As String    
Dim stremSubject As String    
Dim i As Long    
Dim x As Long    
Dim count As Long    
Dim RegEx As Object

Set RegEx = CreateObject("VBScript.RegExp")

Dim xlApp As Object 'Excel.Application    
Dim xlwkbk As Object 'Excel.Workbook    
Dim xlwksht As Object 'Excel.Worksheet    
Dim xlRng As Object 'Excel.Range

Set olApp = Outlook.Application    
Set olExp = olApp.ActiveExplorer    
Set olFolder = olExp.CurrentFolder

'Open Excel
Set xlApp = GetExcelApp
xlApp.Visible = True
If xlApp Is Nothing Then GoTo ExitProc

Set xlwkbk = xlApp.workbooks.Add
Set xlwksht = xlwkbk.Sheets(1)
Set xlRng = xlwksht.Range("A1")
xlRng.Value = "Bounced email addresses"

'Set count of email objects
count = olFolder.Items.count

'counter for excel sheet
i = 0
'counter for emails
x = 1

For Each obj In olFolder.Items
    xlApp.StatusBar = x & " of " & count & " emails completed"
  stremBody = obj.Body
  stremSubject = obj.Subject

    'Check for keywords in email before extracting address
    If checkEmail(stremBody) = True Then
        'MsgBox ("finding email: " & stremBody)
        RegEx.Pattern = "\b[A-Z0-9._%+-]+@[A-Z0-9.-]+\.[A-Z]{2,4}\b"
        RegEx.IgnoreCase = True
        RegEx.MultiLine = True
        Set olMatches = RegEx.Execute(stremBody)
        For Each match In olMatches
            xlwksht.cells(i + 2, 1).Value = match
            i = i + 1
        Next match
        'TODO move or mark the email that had the address extracted
    Else
        'To view the items that aren't being parsed uncomment the following line
        'MsgBox (stremBody)
    End If

    x = x + 1
Next obj
xlApp.ScreenUpdating = True
MsgBox ("Invalid Email addresses are done being extracted")

ExitProc:
Set xlRng = Nothing
Set xlwksht = Nothing
Set xlwkbk = Nothing
Set xlApp = Nothing
Set emItm = Nothing
Set olFolder = Nothing
Set olNS = Nothing
Set olApp = Nothing
End Sub

Function GetExcelApp() As Object
' always create new instance
On Error Resume Next
Set GetExcelApp = CreateObject("Excel.Application")
On Error GoTo 0
End Function

Answer 1

untested

replace

RegEx.Pattern = "\b[A-Z0-9._%+-]+@[A-Z0-9.-]+\.[A-Z]{2,4}\b"
RegEx.IgnoreCase = True
RegEx.MultiLine = True

with

 RegEx.Pattern = "\b[A-Z0-9._%+-]+@[A-Z0-9.-]+\.[A-Z]{2,4}\b"
 RegEx.IgnoreCase = True
 RegEx.MultiLine = True
 RegEx.Global = True

Answer 2

I have noticed the following line of code:

Set olApp = Outlook.Application    

If you run the code in Outlook, you need to use the Application property to get an instance of the Application class. Or you need to use the New operator to create a new instance, for example:

 Set ol = New Outlook.Application

or

 Set objOL = CreateObject("Outlook.Application")

See How to automate Outlook from another program for more information.

You may also consider using the Word object model for working with item bodies. The WordEditor property of the Inspector class returns an instance of the Document class which represents the message body. See Chapter 17: Working with Item Bodies for more information.