I'd like to share some Outlook VBA code I wrote for a site visitor who asked for something to process bounced emails. He sends out marketing emails and gets undeliverable reports back, usually when the email address is invalid. He'd like to take the email addresses from the bounce emails and create an Excel worksheet with them.
The bounce emails are collected into a subfolder called "Bounced." There are several different types of bounces, because each mail server sends a message formatted slightly differently.
After setting a reference to the Bounced folder, we loop through the folder and check each email's subject to see which type of email it is. Then we parse the body for the email address and add it to an array.
Finally, the array is dumped into a worksheet. I listed two ways to write to the worksheet: the loop and resize methods. Everything is late bound so you won't need to set a reference to the Excel Object Library.
Sub Extract_Invalid_To_Excel()
Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace
Dim olFolder As Outlook.MAPIFolder
Dim obj As Object
Dim emItm As Outlook.MailItem
Dim stremBody As String
Dim stremSubject As String
Dim lFirstPos As Long
Dim lLastPos As Long
Dim BadUserList As Variant
Dim i As Long
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 olNS = olApp.GetNamespace("MAPI")
Set olFolder = olNS.GetDefaultFolder(olFolderInbox).Folders("Bounced")
' set up size of variant
ReDim BadUserList(olFolder.Items.Count)
' initialize variant position counter
i = 0
' parse each message in the folder holding the bounced emails
For Each obj In olFolder.Items
Set emItm = obj
stremBody = emItm.Body
stremSubject = emItm.Subject
Select Case stremSubject
Case "Delivery Failure"
lFirstPos = InStr(stremBody, "Failed Recipient: ") + 18
lLastPos = InStr(lFirstPos + 1, stremBody, vbCr)
Case "Returned mail: see transcript for details"
lFirstPos = InStr(stremBody, "via localhost, to <") + 19
lLastPos = InStr(lFirstPos + 1, stremBody, ">")
Case "Delivery Status Notification (Failure)"
lFirstPos = InStr(stremBody, "destination mail server.") + 35
If lFirstPos = 35 Then ' those words aren't in the email, must be the
' other kind
lFirstPos = InStr(stremBody, "recipients failed") + 29
End If
lLastPos = InStr(lFirstPos + 1, stremBody, vbCr)
lLastPos = InStr(lLastPos + 1, stremBody, vbCr)
lLastPos = InStr(lLastPos + 1, stremBody, vbCr)
End Select
BadUserList(i) = Mid$(stremBody, lFirstPos, lLastPos - (lFirstPos))
i = i + 1
Next obj
' write everything to Excel
Set xlApp = GetExcelApp
If xlApp Is Nothing Then GoTo ExitProc
Set xlwkbk = xlApp.Workbooks.Add
Set xlwksht = xlwkbk.Sheets(1)
Set xlRng = xlwksht.Range("A1")
xlApp.ScreenUpdating = False
xlRng.Value = "Bounced email addresses"
' resize version
xlRng.Offset(1, 0).Resize(UBound(BadUserList) + 1).Value = xlApp.Transpose(BadUserList)
' loop version
'For i = LBound(BadUserList) To UBound(BadUserList)
' Cells(i + 2, 1).Value = BadUserList(i)
'Next i
' optional
'ActiveSheet.UsedRange.Columns.AutoFit
xlApp.Visible = True
xlApp.ScreenUpdating = True
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
Today's challenge: add code to move the processed emails to another folder, leaving the untouched ones in the Bounced folder – Any takers?
Optional: add toolbar button to run code on demand:
See How to assign a macro to a toolbar button or run the following code in a standard module in Outlook VBIDE:
Public Sub AddButton()
' based on http://www.slovaktech.com/code_samples.htm#HyperlinkButton
' run once to add the button to your toolbar
Dim objButton As Office.CommandBarButton
Dim objBar As Office.CommandBar
Dim strCaption As String
Dim strURL As String
Set objBar = ActiveExplorer.CommandBars("Advanced")
Set objButton = objBar.Controls.Add(msoControlButton)
If Not objBar.Visible Then
objBar.Visible = True
End If
strCaption = "Process Bounced Msgs"
With objButton
.Caption = strCaption
.OnAction = "Extract_Invalid_To_Excel"
.BeginGroup = True
End With
Set objButton = Nothing
Set objBar = Nothing
End Sub
About JP
23 Comments:
outlook does an error telling " runtime error"5" invalida procedure call or argument.
BadUserList(i) = Mid$(stremBody, lFirstPos, lLastPos – (lFirstPos))
Can you help me?
Nick,
What are the values of stremBody, lFirstPos and lLastPos when the error occurs?
JP,
I'm testing this code, and I got the same runtime error, What do you mean by Values? Hope that doesn't sound like a begginer question. But if it is, hope you can help still, as this would be a needed macro.
Thanks
CR
Need more information. What line causes the error?
If you step through the code (by pressing F8 repeatedly), you can hover your mouse pointer over each variable to see its current value. If you get an error on the line that puts values into the array (the line that starts "BadUserList(i) = …" then you can hover over each variable (stremBody, lFirstPos, lLastPos) and check what they hold.
JP – I get a 'Run-time error 13: Type mismatch'
which debugs to line:
Set emItm = obj
any thoughts?
emItm is declared as Outlook.MailItem, so the Bounced folder can only contain Mailitems.
JP – Thank you! You are my hero! This will definitely help.
I also got this error:
"outlook does an error telling " runtime error"5" invalid procedure call or argument.
BadUserList(i) = Mid$(stremBody, lFirstPos, lLastPos – (lFirstPos))"
My values are:
stremBody = "Hi, this is the qmail …" (seems to be the body of the first email)
lFirstPos = 0
lLastPos = 0
BadUserList(i) is empty
Not super familiar with using macos, but this would be really helpful- what do you suggest from here?
- Amanda Byrne, IT Administrator, Carolina Tiger Rescue
I did end up correcting this issue by adding a case to the code that was common in my bouncebacks. It still needs tweaking, but it is functional. Thanks so much!
I had to split up my bouncebacks into foldrs because I got a bunch of "Undeliverable"s from the System Administrator that are not Mailitems. Can you suggest a way to modify this code, either so the same works for both, or I can add another macro to accomodate these?
But already, you've saved me a few hours of data entry.
Gratefully, Amanda
I got the same error as Amanda. And I have no idea about coding … it crashed on the first run with an out of office reply. Any help will be great. Thanks.
The exact name for that type of item escapes me at the moment, but it's a system-generated message. I'll see what I can do.
Thanks a lot.. will wait for your reply
Sorry for the late reply, while replying to another comment I just realized that you mentioned "out of office reply" — this code is specifically meant to handle undeliverable emails, which were collected into a single folder. You can't just run it on any folder without filtering it first.
Sorry to be a pest but I don't see were you answered Amanda's question. I'm getting the same error code and don't have a clue as to fixing it.
Thanks
Rich
July 8, 2010 at 4:14 am
I got the same error as Amanda. And I have no idea about coding … it crashed on the first run with an out of office reply. Any help will be great. Thanks.
Rich,
She answered her own question, see above.
FWIW, there are many different types of email servers, each one formats bounce reports differently. There's a Select Case statement so anyone out there can add or remove conditions based on new types. Which, FYI, is exactly what Amanda did to resolve her issue.
I'm afraid you'll need to do the same thing — isolate which emails aren't being properly identified by the existing code, and add Case statements to handle them.
Hey,
is there a solution for Outlook Express or Thunderbird?
Many thanks
I seriously doubt it. Neither program supports VBA and I see no other mechanism for setting up the bounced email list.
I used this code without errors – great and thanks for posting it.
I saw another version but didn't implement it, using regular expressions:
The code below comes from the post on http://www.vbaexpress.com/forum/showthread.php?t=33363.
Thanks to everyone in both sites for contributions. My next mission is to get this built into a POP3 reader to automatically detect bounced emails and mark bad email addresses in a database on the webserver. Don't really want to delete the email address, I just don't want to delete the prospect.
If anyone wants the code they can go to that link.
And as I mentioned in that thread — with RegEx, the results are unpredictable. Some bounced emails contain the email address of the sender as well as the intended recipient.
I saw that possibility, and that code needs tweeking to add in the checks used in your code, perhaps with some additional processing of error numbers. e.g. error 601 is not necessarily a dud email address. What I like about pattern matching is that you'll get a well formed email address. So your code has done the job as all my returns i've had to process are exactly the same (except for the error codes -even though error descrition is the same).
Thank you for this. Was able to adapt it to work nicely and make a best effort to record the reason, writing a result to a database. is there any way this could be adapter to handle items when the message class is 'undelivered report' or convert 'undelivered report' to a mail item?
Hi JP, Im scrubbing my email list today and found your post. I'm going to try this right now. I'm hoping I don't have trouble doing this on my iMac
lots of undeliverables to go through 
Thanks JP!
Macs use a different version of VBA, you won't be able to use this code without severe editing. I'm afraid I won't be able to help you convert it.