In this post, I publish the Visual Basic (VBA) code for Microsoft Outlook. It is used to create a list of unavailable emails. For example, I want to personalize an email to send to all my colleagues. Each email has a different link. For this reason, I use Microsoft Word to send the emails using the Mailing function.
Mail Merge in Microsoft Word
Mail Merge is one of Microsoft Word’s most powerful features. It enables you to personalise documents at scale. This is done by pulling data from a source like Excel. But did you know you can take personalisation a step further by embedding custom hyperlinks for each recipient? This technique is a game-changer for marketing campaigns, surveys, and event invitations.
Prepare Your Data Source
- Create an Excel sheet (or other supported source) with columns for names, emails, and a dedicated column for URLs.
Set Up Mail Merge in Word
- Go to Mailings > Start Mail Merge and select your document type (letters, emails, etc.).
- Connect to your data source via Select Recipients > Use an Existing List.
Insert Custom Hyperlinks
- Place your cursor where you want the link.
- Use Insert > Hyperlink.
- In the “Address” field, insert the merge field for your URL column (e.g.,
«Link»). - The display text can be static (like “Click Here”) or dynamic (e.g.,
«Name»’s Survey Link).
Preview & Test
- Use Preview Results to ensure each recipient’s link is correctly embedded.
- Test a few merged documents to confirm the hyperlinks are active.
After sending emails
After Word finishes to send all the emails, probably some of them are not deliverable. So, I want to have a list of the unavailable emails to remove them from the list. I don’t want to do it manually, so I wrote a script.
What the script does
- It scans all the emails in your Inbox one by one.
- Finds bounce‑back emails (NDRs)
- It checks the subject line for typical “failure” phrases like Undeliverable or Delivery Status Notification.
- These are the messages Outlook/Exchange sends you when an email couldn’t be delivered.
- Filters by your original subject
- It only processes bounce‑backs that mention the subject of the email you care about (you set this in
subjectFilter = "Your Subject Here"). - This way, you only collect failures related to that particular campaign or batch of emails.
- It only processes bounce‑backs that mention the subject of the email you care about (you set this in
- Extracts failed addresses
- It looks inside the body of the bounce message and uses a pattern (RegEx) to find anything that looks like an email address.
- If it finds one, it saves it.
- If it doesn’t, it falls back to using the
ToorSenderEmailAddressfields.
- Skips duplicates
- It uses a dictionary to make sure the same failed address isn’t added twice.
- Excludes certain domains
- You can keep a list of domains you don’t care about (e.g.,
"exchangelabs.com","example.com") and the script will skip any addresses ending with those domains.
- You can keep a list of domains you don’t care about (e.g.,
- Optional: Marks the bounce email as read
- There’s a variable (
markAsRead) you can set toTrueorFalse. - If
True, the script will mark each processed bounce message as “Read” so they don’t clutter your Inbox.
- There’s a variable (
- Exports results to a CSV file
- After collecting all the failed addresses, it writes them into a file called
UnavailableEmails.csvon your Desktop. - The file has one column called
FailedRecipientwith all the addresses listed. - You can open this file directly in Excel.
- After collecting all the failed addresses, it writes them into a file called
- Shows a completion message
- When it’s done, it pops up a message box telling you the export is complete and where the file is saved
VBA script
Sub ExportUnavailableEmails()
Dim ns As Outlook.NameSpace
Dim inbox As Outlook.Folder
Dim items As Outlook.items
Dim itm As Object
Dim subjectFilter As String
Dim failedAddresses As Object
Dim filePath As String
Dim fso As Object, ts As Object
' === Configure ===
' change the subject
subjectFilter = "URGENT INPUT REQUIRED"
filePath = Environ("USERPROFILE") & "\Desktop\UnavailableEmails.csv"
' Set to True if you want to mark emails as read, False to leave them
Dim markAsRead As Boolean
maskAsRead = True
' === Setup ===
Set ns = Application.GetNamespace("MAPI")
Set inbox = ns.GetDefaultFolder(olFolderInbox)
Set items = inbox.items
items.Sort "[ReceivedTime]", False
Set failedAddresses = CreateObject("Scripting.Dictionary")
' === Define excluded domains ===
Dim excludedDomains As Variant
excludedDomains = Array("example.com", "testdomain.org")
' === Iterate items ===
Dim i As Long
For i = items.Count To 1 Step -1
Set itm = items.item(i)
If Not itm Is Nothing Then
If itm.Class = olMail Or itm.Class = olReport Then
If InStr(1, itm.Subject, "Undeliverable", vbTextCompare) > 0 _
Or InStr(1, itm.Subject, "Delivery Status Notification", vbTextCompare) > 0 Then
If InStr(1, itm.Body, subjectFilter, vbTextCompare) > 0 Then
Dim emails As Collection
Set emails = ExtractEmailsFromText(itm.Body)
Dim e As Variant
For Each e In emails
If Not IsExcludedDomain(e, excludedDomains) Then
If Not failedAddresses.Exists(LCase$(e)) Then
failedAddresses.Add LCase$(e), True
End If
End If
Next e
End If
' Mark as read if variable is True
If maskAsRead Then
itm.UnRead = False
End If
End If
End If
End If
Next i
' === Write CSV ===
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.CreateTextFile(filePath, True)
ts.WriteLine "FailedRecipient"
Dim key As Variant
For Each key In failedAddresses.Keys
ts.WriteLine key
Next key
ts.Close
MsgBox "Export complete! Saved to: " & filePath
End Sub
' Helper: check if email ends with any excluded domain
Private Function IsExcludedDomain(ByVal email As String, ByVal domains As Variant) As Boolean
Dim d As Variant
Dim addr As String
addr = LCase$(Trim$(email))
For Each d In domains
If Right$(addr, Len(d)) = LCase$(d) Then
IsExcludedDomain = True
Exit Function
End If
Next d
IsExcludedDomain = False
End Function
' Helper: extract emails with RegEx
Private Function ExtractEmailsFromText(ByVal text As String) As Collection
Dim re As Object, matches As Object, m As Object
Set ExtractEmailsFromText = New Collection
Set re = CreateObject("VBScript.RegExp")
re.Pattern = "([A-Za-z0-9._%+-]+@[A-Za-z0-9.-]+\.[A-Za-z]{2,})"
re.IgnoreCase = True
re.Global = True
If re.Test(text) Then
Set matches = re.Execute(text)
For Each m In matches
ExtractEmailsFromText.Add m.Value
Next m
End If
End Function
Happy coding!
