Extracting Email Addresses in Outlook with a macro
So for the last few days I've been working on a problem that seems fairly common throughout the e-marketing world. The problem arises when you send out your marketing email blasts and then all the bad email addresses (but they're not all bad!) come bouncing back. Obviously we want to remove those from the mailing list, but we don't want to walk through thousands of emails to get the bad addresses, but at the same time not all the emails bounced back were bad (out of office replys, etc).
So I've found some programs that allow you to extract email addresses from the different fields of your emails, but all the ones I've tried ONLY can get the address from an actual MailItem. What if there is a message that isn't a MailItem? Well, that was my problem so that option didn't work. I'm not sure exactly what kind of Item it is but it is an Item. (just for the record MailItem and Item are actual VB objects in outlook for more info Go Here)
So here is some code that I've come up with after overhauling some examples that I saw. This macro will:
- Look in the currently open folder
- Will open up an Excel worksheet
- Check for some common keywords that show up only in the bad emails(they are easy to change)
- and stick all the email addresses it finds from those emails in the Excel sheet.
It also has a little progress count in Excel's status bar so you know it's still thinking (I hate it when you can't tell a script is running).
Note: So far this has only been tested in Outlook 2007, but I don't see any reason why it won't work in 2003. We'll be testing that shortly.
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 = False
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
Function checkEmail(ByVal Body As String) As Boolean
Dim keywords(25) As String
keywords(0) = "Delivery to the following recipients failed"
keywords(1) = "user unknown"
keywords(2) = "The e-mail account does not exist"
keywords(3) = "undeliverable address"
keywords(4) = "550 Host unknown"
keywords(5) = "No such user"
keywords(6) = "Addressee unknown"
keywords(7) = "Mailaddress is administratively disabled"
keywords(8) = "unknown or invalid"
keywords(9) = "Recipient address rejected"
keywords(10) = "disabled or discontinued"
keywords(11) = "Recipient verification failed"
keywords(12) = "no mailbox here by that name"
keywords(13) = "This user doesn't have a yahoo.com account"
keywords(14) = "No mailbox found"
keywords(15) = "not our customer"
keywords(16) = "mailbox unavailable"
keywords(17) = "Mailbox disabled"
keywords(18) = "mailbox is inactive"
keywords(19) = "address error"
keywords(20) = "unknown recipient"
keywords(21) = "unknown user"
keywords(22) = "mail to the recipient is not accepted on this system"
keywords(23) = "no user with that name"
keywords(24) = "invalid recipient"
'Default value
checkEmail = False
For Each word In keywords
If InStr(1, Body, word, vbTextCompare) > 1 Then
checkEmail = True
Exit For
End If
Next word
End Function |
PS - I also learned a valuable lesson to not trust regular expressions that people post in forums, but that's another story.
Print This Post
April 30th, 2009 - 17:13
It’s called a ReportItem — a system generated email from Outlook that is created when an email cannot be delivered.
The problem I’ve found with just searching the body for xxx@xxx.com is that sometimes the recipient’s email address is included in the delivery failure. Which email address will your code extract?
Also –
You set emItm to Nothing, but never declared or used it in your code.
You set ScreenUpdating to True, but had never set it to False.
Both of those were present in my code.
http://www.codeforexcelandoutlook.com/blog/2009/02/bounced-email-list-maker/
You also have “For Each match” but I don’t see a variable named match declared.
Take care,
JP
May 1st, 2009 - 07:23
Hey thanks for the info and corrections. I’ll be sure to fix those.
Also the reason I search in the body is that we’re not going to be looking through any “real” emails but they should all be bounced emails in that folder so we are actually looking for the recipient’s email addresses in the messages that have the keywords that tell us it really is a bad email address. I think right now we’re able to extract about 70-80% of the bad emails that come back but with some keyword tweaking we can get that higher.
May 7th, 2009 - 01:42
I added a few more keywords and it seemed to pick up a whole load more, almost all of them bar 50 (1111 out of 1176 emails). I had trawled through and removed out of offices and left only those from “System Administrator” and “Mail Delivery System”
keywords(25) = “message could not be delivered”
keywords(26) = “Host or domain name not found”
keywords(27) = “Connection timed out”
keywords(28) = “The following recipient(s) could not be reached”
Then I changed the line above this one to “Dim keywords(29) As String” – 29 instead of 25!
Looking through to see if I missed anything. Does this ‘remove’ dupplicates?
The best solution I have found on the net so far, my search is over.
PS That was in Outlook 2003
May 7th, 2009 - 01:47
How do your two codes differ?
May 7th, 2009 - 01:53
Me Again! Whilst checking manually through my returned emails, I discovered that some had not stated the email address of the contact only their name i.e.
“Joe Bloggs on 23/04/2009 15:09
The e-mail account does not exist at the organization this message was sent to…”
So I think the 65 emails that weren’t found were probably because they didn’t exist in this list.
Next time I send the list minus the 1111 I may have more of a change of manually searching for the names in my list and removing them.
Thanks again Brett, you’ve made me a happier man
May 7th, 2009 - 07:19
@Stuart
I’ve noticed the same on our bounced emails. This isn’t a cure-all for bounced emails but it should take out most of the work. You’ll still have to do some by hand. And no this won’t take out duplicate emails since that wasn’t a requirement for our setup.
But I’m glad you found it useful and thanks for your comments.
May 13th, 2009 - 05:00
Is it possible to populate email id of (email id of person mention in To) in a particular folder in excel file.
Pl reply
May 13th, 2009 - 23:25
Pl reply
May 14th, 2009 - 07:16
@Vaibhav I just want to make sure I understand. You want to write the “To” field to another excel file? If that’s the case and you’re going through the bounced emails the “To” field will be to your email address.
May 14th, 2009 - 21:19
Dear Brett
Thanks for your reply, i wanted to extract email from particular folder, no restriction for bounced email only.
May 15th, 2009 - 07:13
@Vaibhav
If you want to extract every email address found in the folder you would just have to remove the statement that checks to see if keywords are found (If checkEmail(stremBody) = True Then) and obviously clean up a few little things. But if you’re looking for some particular keywords you can modify the checkEmail function to check for whatever you need or you can modify it to check for the subject etc. without changing too much.
Hopefully this helps. Thanks!
July 9th, 2010 - 01:02
You’re a legend. Popped this into the macro builder in Office 2010 and away we went! Worked first time. Wish I had of found this earlier rather than wasting my time with buying other software. Thanks!!!
July 9th, 2010 - 07:05
Thanks for the ego boost Steve.
I’m glad you found it useful.
August 25th, 2010 - 00:53
Hey guys,
is there a solution for Outlook Express or Thunderbird?
Many thanks
September 22nd, 2010 - 12:27
ok what am I doing wrong.
I created a new macro in outlook, paste din your code. opened the folder with my bounces and run the macro.
It opens excel and says it etracted 199 emails, but the spreadsheet is empty ?
Using outlook/excel 2007
October 4th, 2010 - 08:47
Hey, tried both this and JPs code.
I setup the macro(s) and digitally signed them so they work. Then when I run them, I just get a spreadsheet open up with: “Bounced email addresses” in it… Nothing else.
I’m not too clued up on VB or macros, but would appreciate your help.
K
October 4th, 2010 - 09:04
@Russ and @Keir
Somethings to double check would to make sure that the keywords in the macro actually are in the emails. To add new items you’ll need to change the line
Dim keywords(25) As String. The 25 should be changed to the total number of keywords that are in the array. So if you added two item, that number should be 27.
If that looks ok you can add some breakpoints in the For Each loop and see what the text from the body and subject are and why they’re not being matched correctly.
I Hope this helps.
October 4th, 2010 - 09:10
Ignore that. Solved:
Deleted the macros module
Created self siged certificate
Deleted the macros tool bar button I had created
Restarted outlook
Recreated the macros using code above
recreated the tool bar button
WORKS!!
Thanks for the code
October 6th, 2010 - 10:24
Brilliant, really really nice script. I checked some other forums and they came up with nothing. You come with an immediately working example which is easily extensible.
Thanks a lot!
February 10th, 2011 - 21:22
Awesome. You’re a lifesaver.
March 23rd, 2011 - 14:28
You are awesome! Just tried this on 2010 version, picked up EVERY single one! Thank you!
April 28th, 2011 - 09:23
Awesome. Thank you.
May 2nd, 2011 - 11:39
Awesome, just saved me hours and hours, never knew anything like this was possible.. cheers dude!
June 9th, 2011 - 09:52
I can’t quite get this working. It is only extracting the first email address it finds in the body of the email. Many of the emails we have bounce back are sent from a “postmaster” account and the desired email is further down in the email’s body. Any way to account for this?
Thanks-
Jason
November 1st, 2011 - 07:32
You saved me hours! Thanks a bunch!
November 1st, 2011 - 07:49
It might be helpful, if the macro would move mails from which it extracted an address into a subfolder, to allow inspection of what was rejected.
December 26th, 2011 - 16:15
@Jason : you may have found the answer to your concern already
in case you didn’t, http://www.regular-expressions.info/vbscript.html reads that “if you want the RegExp object to return or replace all matches instead of just the first one, set the Global property to True.”
January 2nd, 2012 - 16:12
thank you for this Macro! i help me a lot.