Outlook VBAで差出人のメールアドレスを取得する方法

皆さん、こんにちは。今日は、Outlookで受信したメールの差出人のメールアドレスをVBAを使って取得する方法についてお話しします。特に、同じ組織内でExchangeを利用している場合、通常の方法では正しいメールアドレスが取得できないことがあります。そんな時の対処法も含めて、初心者の方にもわかりやすく解説します。

差出人のメールアドレスを取得する基本方法
Exchange環境での注意点
正しいメールアドレスを取得する方法
実際の使用例
よくある質問や疑問
1. Q1: なぜ`SenderEmailAddress`では正しいアドレスが取得できないのですか？
2. Q2: このコードはOutlookのどのバージョンで動作しますか？
今すぐ解決したい！どうしたらいい？
まとめ

差出人のメールアドレスを取得する基本方法

Outlookのイメージ

まず、基本的な方法から説明します。OutlookのVBAでは、受信したメールの差出人のメールアドレスを取得するために、`MailItem`オブジェクトの`SenderEmailAddress`プロパティを使用します。以下にサンプルコードを示します。

vb

Sub GetSenderEmail()

    Dim mail As Outlook.MailItem

    Set mail = Application.ActiveInspector.CurrentItem

    MsgBox "差出人のメールアドレスは: " & mail.SenderEmailAddress

End Sub

このコードを実行すると、現在選択しているメールの差出人アドレスが表示されます。

Exchange環境での注意点

しかし、Exchange環境で同じ組織内のユーザーからのメールの場合、`SenderEmailAddress`プロパティは期待した形式のアドレスを返さないことがあります。例えば、`/o=組織名/ou=グループ名/cn=Recipients/cn=ユーザー名`のような形式です。これは、Exchange特有のアドレス形式で、直接メールを送信する際には適していません。

正しいメールアドレスを取得する方法

この問題を解決するためには、`PropertyAccessor`オブジェクトを使用して、正しいSMTPアドレスを取得する必要があります。以下に、その方法を示します。

vb

Private Function GetSenderSMTPAddress(mail As Outlook.MailItem) As String

    Dim PR_SMTP_ADDRESS As String

    PR_SMTP_ADDRESS = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"
    If mail.SenderEmailType = "EX" Then

        Dim sender As Outlook.AddressEntry

        Set sender = mail.Sender
        If Not sender Is Nothing Then

            Dim exchUser As Outlook.ExchangeUser

            Set exchUser = sender.GetExchangeUser()

If Not exchUser Is Nothing Then GetSenderSMTPAddress = exchUser.PrimarySmtpAddress Else GetSenderSMTPAddress = sender.PropertyAccessor.GetProperty(PR_SMTP_ADDRESS) End If End If Else GetSenderSMTPAddress = mail.SenderEmailAddress End If End Function

この関数を使うことで、Exchange環境でも正しいSMTPアドレスを取得できます。

実際の使用例

では、具体的にこの関数をどのように使うか見てみましょう。例えば、受信トレイ内のすべてのメールの差出人アドレスを表示する場合、以下のようなコードになります。

vb

Sub ListSenderEmails()

    Dim inbox As Outlook.Folder

    Set inbox = Application.Session.GetDefaultFolder(olFolderInbox)

Dim mail As Outlook.MailItem For Each mail In inbox.Items If TypeName(mail) = "MailItem" Then Debug.Print "件名: " & mail.Subject Debug.Print "差出人アドレス: " & GetSenderSMTPAddress(mail) End If Next End Sub

このコードを実行すると、イミディエイトウィンドウに受信トレイ内の各メールの件名と差出人アドレスが表示されます。

よくある質問や疑問

Q1: なぜ`SenderEmailAddress`では正しいアドレスが取得できないのですか？

Exchange環境では、同じ組織内のユーザーのアドレスが内部形式（X500形式）で保存されているため、`SenderEmailAddress`プロパティではその形式のアドレスが返されます。これを通常のSMTPアドレスに変換するためには、`PropertyAccessor`オブジェクトを使用する必要があります。