När du skickar e-post till ogiltiga mottagaradresser får du meddelanden om olevererbara e-postadresser. Om du då vill ta bort dessa e-postadresser från kontakterna kan du använda metoden som delas i det här inlägget.
Har du någonsin fått e-postmeddelanden som inte kan levereras med de ogiltiga e-postadresserna? I allmänhet får du sådana e-postmeddelanden när du skickar e-post till ogiltiga mottagaradresser. I den här situationen rekommenderas det i allmänhet att ta bort dessa e-postadresser från Outlook-kontakterna för att förhindra att misstag skickar e-post till dem nästa gång. Nu, i det följande, kommer vi att dela dig med en snabb lösning för att få det.
Ta bort ogiltiga mottagaradresser för ej levererbara e-postmeddelanden från kontakter
- Till att börja med, tryck på "Alt + F11" i Outlook-fönstret för att komma åt VBA-redigeraren.
- Därefter kan du lägga till följande VBA-kod i ett oanvänt projekt eller en modul.
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
- Stäng sedan det aktuella fönstret efter det.
- Senare lägger du till det nya makrot i snabbåtkomstverktygsfältet. Du kan hänvisa till artikeln - “Hur du kör VBA-kod i din Outlook".
- Slutligen kan du köra detta makro genom att följa stegen nedan:
- Först och främst väljer du "Undeliverable" e-postmeddelanden.
- Klicka sedan på makrot i verktygsfältet Snabbåtkomst.
- När makrot är klart får du meddelandet "Slutfört".
- Nu kan du kontrollera tillhörande kontakter där de ogiltiga e-postadresserna har tagits bort, som skärmdumpen nedan:
Lös Outlook-fel och korruption
Som vi alla vet kan Outlook bli utsatt för problem och korruption av olika skäl. Därför, om du är en nybörjare i Outlook, skulle du bättre göra några effektiva försiktighetsåtgärder, som att göra periodiska säkerhetskopior av data, använda en kraftfull och pålitlig Outlook-reparation verktyg, som DataNumen Outlook Repair, Och så vidare.
Författarintroduktion:
Shirley Zhang är expert på dataåterställning DataNumen, Inc., som är världsledande inom teknik för återställning av data, inklusive återhämta sql och Outlook-programvara för reparationsprogramvara. För mer information besök www.datanumen.com