When sending emails to any invalid recipient addresses, you would receive the undeliverable email notifications. At that point, if you may want to remove these email addresses from contacts, you can use the method shared in this post.
Have you ever received undeliverable email notifications listing the invalid email addresses? In general, you’ll get such emails after you send email to invalid recipient addresses. In this situation, it is generally suggested to remove these email addresses from Outlook contacts to prevent accidentally sending mails to them next time. Now, in the followings, we will share you a rapid solution to get it.
Remove the Invalid Recipient Addresses of Undeliverable Emails from Contacts
- For a start, in the Outlook window, press “Alt + F11” to access VBA editor.
- Next, you can put the following VBA code into an unused project or module.
Sub RemoveUndeliverableEmailAddressesfromContacts() Dim objSelection As Outlook.Selection Dim objContacts As Outlook.Items Dim objMail As Outlook.MailItem Dim i, n As Long Dim objWordApp As Word.Application Dim objWordDocument As Word.Document Dim strEmailAddress As String Dim strFilter As String Dim objFoundContact As Outlook.ContactItem 'Get selected emails Set objSelection = Application.ActiveExplorer.Selection 'Get the contacts Set objContacts = Application.Session.GetDefaultFolder(olFolderContacts).Items On Error Resume Next For Each objMail In objSelection objMail.Display Set objWordDocument = objMail.GetInspector.WordEditor Set objWordApp = objWordDocument.Application Set objSearchRange = objWordDocument.Range 'Extract email addresses via wildcards With objWordApp.Selection.Find .Text = "[A-z,0-9]{1,}\@[A-z,0-9,.]{1,}" .MatchWildcards = True .Execute End With While objWordApp.Selection.Find.Found strEmailAddress = objWordApp.Selection.Text 'Remove the invalid email addresses from the associated contacts strFilter = "[Email1Address] = " & strEmailAddress Set objFoundContact = objContacts.Find(strFilter) If Not (objFoundContact Is Nothing) Then With objFoundContact .Email1Address = "" .Email1DisplayName = "" .Save End With strFilter = "" Set objFoundContact = Nothing Else strFilter = "[Email2Address] = " & strEmailAddress Set objFoundContact = objContacts.Find(strFilter) If Not (objFoundContact Is Nothing) Then With objFoundContact .Email2Address = "" .Email2DisplayName = "" .Save End With strFilter = "" Set objFoundContact = Nothing Else strFilter = "[Email3Address] = " & strEmailAddress Set objFoundContact = objContacts.Find(strFilter) If Not (objFoundContact Is Nothing) Then With objFoundContact .Email3Address = "" .Email3DisplayName = "" .Save End With strFilter = "" Set objFoundContact = Nothing End If End If End If objWordApp.Selection.Find.Execute Wend objMail.Close olDiscard Next MsgBox "Completed!", vbInformation End Sub
- After that, close the current window.
- Later, add the new macro to Quick Access Toolbar. You can refer to the article – “How to Run VBA Code in Your Outlook“.
- Finally, you can run this macro by following the steps below:
- In the first place, select the “Undeliverable” email messages.
- Then, click the macro in the Quick Access Toolbar.
- When macro finishes, you’ll receive the message prompting “Completed”.
- Now, you could check the associated contacts, in which the invalid email addresses have been removed, like the screenshot below:
Resolve Outlook Errors and Corruption
As we all know, Outlook can get subject to the issues and corruptions for various reasons. Hence, if you are a novice in Outlook, you’d better make some effective precautions, such as making periodical data backups, employing a powerful and reliable Outlook repair utility, like DataNumen Outlook Repair, and so on.
Author Introduction:
Shirley Zhang is a data recovery expert in DataNumen, Inc., which is the world leader in data recovery technologies, including recover sql and outlook repair software products. For more information visit www.datanumen.com
Leave a Reply