VBA Outlook 重複送信先の削除

Outlookでメール送信する際に、送信先に設定したアドレス情報のうち、重複設定してしまったアドレスを削除したいというご要望がありました。

そこで、Outlookに組み込んだVBAプログラムで、送信先に設定されたアドレス情報のうち、アドレス表示名が一致するものを削除するものを作成しました。

実行時のイメージは下図となります。

実行イメージ

Outlookに組み込むプログラムは次の通りです。

Option Explicit

'重複送信先の削除
Public Sub RemoveDuplicateName()
    Dim oMailItem As MailItem
    Set oMailItem = Application.ActiveInspector.CurrentItem
    
    With oMailItem.Recipients
        Dim i As Long: i = 1
        
        Do While i < .Count
            Dim j As Long: j = i + 1
            
            Do While j <= .Count
                If .Item(i).Name = .Item(j).Name Then
                    .Item(j).Delete
                Else
                    j = j + 1
                End If
            Loop
            
            i = i + 1
            DoEvents
        Loop
    End With
    
    MsgBox "重複送信先の削除完了"
End Sub

OutlookへのVBAプログラムの組込み方法は、以前の記事「VBA Outlook開発環境の整備」をご参照ください。