Outlook VBA（アドレス削除編）

10月1日に出向先の会社名が変わり、それにともないドメインまで変わってしまった。当然ながら暫くは旧ドメインと新ドメインが並行して運用される。そして、メールアドレスが変わる。今回はfromを書き換えることで並行運用するとのこと。

ここでちょっと面倒なのがメーラー（Outlook）の挙動。メーラーを新ドメインに変更しておく前提で、旧ドメインに来たメールに返信すると、自分自身のメールアドレス（以下、自分アドレス）にも関わらず、別人のメールアドレスと判断して、Toに残してしまう。

仕方ないので、Outlook VBAを使って別ドメインの自分アドレスをToから削除するVBAを作成した。即席なので操作によっては不具合があるかもしれないが、私の手癖の範囲では問題なく動作している。

Option Explicit
Private WithEvents myInspectors As Inspectors

Private Sub Application_Startup()
    Set myInspectors = Application.Inspectors
End Sub

Private Sub RemoveMyAdress(ByVal Item As MailItem)
    Dim objRecipient As Recipient
    Dim strMyAddress As String
    strMyAddress = "hoge@old-domain.jp"
    
    If Item.Sender Is Nothing Then
        If Item.Recipients.Count >= 1 Then
            For Each objRecipient In Item.Recipients
                If objRecipient.Address = strMyAddress Then
                    Item.Recipients.Remove objRecipient.Index
                    Exit For
                End If
            Next
        End If
    End If
End Sub

Private Sub myInspectors_NewInspector(ByVal Inspector As Outlook.Inspector)
    If TypeOf Inspector.CurrentItem Is MailItem Then
        RemoveMyAdress Inspector.CurrentItem
    End If
End Sub

参考にしたのはこのサイト。なお、Outlook VBAを動作させるにはデジタル署名が必要だが、ここでの紹介は割愛。
www.compnet.jp