Bounced email list maker
February 26, 2009 • JP • 14 Comments • Rate This Article
• Links to this article
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.
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:
' 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
Automation, Excel, Outlook ·
Rate This Article:
(1 votes, average: 5.00 out of 5)
Loading ...What now?
Subscribe To The Blog
Email This Article
Follow Me On Twitter
My Facebook Page
Or just keep reading:
I'm just an average guy who writes VBA code for a living. This is my personal blog. Excel and Outlook are my thing, with a sprinkle of Access and Word here and there. Follow this space if you want to learn more about VBA. Keep Reading »
Previous Post: Excel Tutorial Series – Advanced Lookup/Counting Functions
Next Post: Amazon Ad Link Generator add-in for Excel
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
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.