Categorize Contacts with bad addresses

A user in our Outlook Forums wanted to know how to filter and delete contacts that contain addresses that bounce. While Outlook doesn't have an automated method for deleting contacts that contain bad addresses, you can use VBA to add a category to the contacts. I recommend adding a category and manually deleting the contacts (or move them to a folder, if you want to keep a history). If you want to delete contacts using a macro, you need to loop backwards, otherwise you'll skip some matches.

Note: the code as written replaces the categories on a contact. To add a category while keeping the existing categories, use myItem.Categories = myItem.Categories & ";Bounced"

If you use Outlook to manage mailing list, you can use the macro to unsubscribe contacts by changing it to use the sender's address.

Categorize Contacts from non-delivery reports

This code sample grabs addresses from non-delivery reports (NDR). It gets the first email address in a message body, such as you'd find in an NDR then looks up the contact and adds a color category.

To use it, select the NDR reports and run the macro.

Sub GetValueUsingRegEx3()
    Dim obj As Object
    Dim Selection As Selection
    Dim olMail As Object 'Outlook.MailItem
    Dim Reg1 As Object
    Dim M1 As Object
    Dim M As Object
    Dim strAddress As String
    Dim myContacts As Items
    Dim myItem As ContactItem

      
    Set Selection = Application.ActiveExplorer.Selection
    Set myContacts = Session.GetDefaultFolder(olFolderContacts).Items

  For Each obj In Selection
    Set olMail = obj

   Set Reg1 = CreateObject("VBScript.RegExp")
     With Reg1
       .Pattern = "(([\w-\.]*\@[\w-\.]*)\s*)"
       .IgnoreCase = True
       .Global = False
    End With
    
    If Reg1.test(olMail.Body) Then
     
        Set M1 = Reg1.Execute(olMail.Body)
        For Each M In M1
             strAddress = M.SubMatches(1)
            Debug.Print strAddress
            
        Set myItem = myContacts.Find("[Email1Address]=" & strAddress)
         
        If TypeName(myItem) = "ContactItem" Then
          If Not TypeName(myItem) = "Nothing" Then
            myItem.Categories = myItem.Categories & ";Delete"
                Debug.Print strAddress & " Delete"
            myItem.Save
         End If
        End If
    
       Next
       
    End If
Next
End Sub

Categorize Sender's Contacts

This version of the macro gets the Sender's email address, finds sender's contact and adds a category to it. Use this to process unsubscription requests.

To use select messages and run the macro.

Public Sub FindCaontactChange()
    Dim Selection As Selection
    Dim currentItem As Object
    Dim objMail As Object
    Dim strAddress As String
    Dim myContacts As Items
    Dim myItem As ContactItem

    Set Selection = Application.ActiveExplorer.Selection
    Set myContacts = Session.GetDefaultFolder(olFolderContacts).Items

    On Error Resume Next

    For Each objMail In Selection
     
        strAddress = objMail.SenderEmailAddress
    Debug.Print strAddress
    
    Set myItem = myContacts.Find("[Email1Address]=" & strAddress)
    If TypeName(myItem) = "ContactItem" Then
      If Not TypeName(myItem) = "Nothing" Then
  ' Match found
        myItem.Categories = "Unsubscribe"
            Debug.Print strAddress & " Unsubscribe"
        myItem.Save
     End If
    End If
           
        Err.Clear
    Next

    Set myItem = Nothing
    Set myContacts = Nothing
    Set objMail = Nothing
    Set currentItem = Nothing
    Set Selection = Nothing

End Sub

Working with a string of addresses

To use this macro, you need a comma separated list of addresses. This can be a list of addresses in Excel or sender's addresses in Outlook (use a custom view containing only the email address field).

Sub DeleteaNDRContact()
   Dim myContacts As Items
   Dim myItem As ContactItem

   Set myContacts = Session.GetDefaultFolder(olFolderContacts).Items
 
For Each myItem In myContacts
  Debug.Print myItem.Email1Address

Select Case myItem.Email1Address
Case "AccountStatus@domain.com", "alias@hotmail.com", "alias@live.com", "user@domain.net"
   myItem.Categories = "Bounced"
   myItem.Save
End Select

Next
End Sub

How to use macros

First: You will need macro security set to low during testing.

To check your macro security in Outlook 2010 or 2013, go to File, Options, Trust Center and open Trust Center Settings, and change the Macro Settings. In Outlook 2007 and older, it’s at Tools, Macro Security.

After you test the macro and see that it works, you can either leave macro security set to low or sign the macro.

Open the VBA Editor by pressing Alt+F11 on your keyboard.

To put the code in a module: