Outlookの連絡先から配信不能な電子メールの無効な受信者アドレスをすばやく削除する方法

Outlookソリューション 2025 年 9 月 29 日

無効な宛先アドレスにメールを送信すると、配信不能メールの通知が届きます。その時点で、これらのメールアドレスを連絡先から削除したい場合は、この記事で紹介する方法をご利用ください。

無効な電子メールアドレスをリストした配信不能な電子メール通知を受け取ったことがありますか？通常、無効な受信者アドレスに電子メールを送信すると、このような電子メールが届きます。この状況では、次回誤ってメールを送信しないように、Outlookの連絡先からこれらの電子メールアドレスを削除することをお勧めします。さて、以下では、それを取得するための迅速な解決策を共有します。

連絡先から配信不能メールの無効な受信者アドレスを削除する

まず、Outlookウィンドウで「Alt + F11」を押してVBAエディターにアクセスします。
次に、次のVBAコードを未使用のプロジェクトまたはモジュールに配置できます。

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

その後、現在のウィンドウを閉じます。
後で、新しいマクロをクイックアクセスツールバーに追加します。あなたは記事を参照することができます–“OutlookでVBAコードを実行する方法"
最後に、以下の手順に従ってこのマクロを実行できます。

まず、「配信不能」の電子メールメッセージを選択します。
次に、クイックアクセスツールバーのマクロをクリックします。
マクロが終了すると、「完了」というメッセージが表示されます。
これで、以下のスクリーンショットのように、無効な電子メールアドレスが削除された関連する連絡先を確認できます。

Outlookのエラーと破損を解決する

ご存知のとおり、Outlookはさまざまな理由で問題や破損の影響を受ける可能性があります。したがって、Outlookの初心者の場合は、強力で信頼性の高いデータを定期的にバックアップするなど、効果的な予防策を講じたほうがよいでしょう。 Outlookの修復のようなユーティリティ DataNumen Outlook Repair、などなど。

著者紹介：

Shirley Zhangは、のデータ復旧の専門家です。 DataNumen、Inc。は、以下を含むデータ復旧技術の世界的リーダーです。 SQLを回復すると見通し修理ソフトウェア製品。詳細については、次のWebサイトをご覧ください。 WWW。datanumen.com