この記事は他のサイトで書いた内容を、自分の備忘録用に転載・まとめたものになります。

他のサイト
VBA - Outlookのメッセージファイル（.msg）から送信元アドレスを取得したい(133262)｜teratail

上記内容の参考にしたサイト
https://msdn.microsoft.com/ja-jp/library/office/ff184624.aspx （180722 リンク切れ）
上記サイト Gooleのキャッシュ（180716）
Outlook 2010 の開発者のための新機能内「差出人の SMTP アドレスの取得」

この記事の概要

MSDN Office Dev Center 内に存在した

【方法】メールアイテムの差出人の SMTP アドレスを取得する（180722 リンク切れ）

の記事内の、C#のコードのVBA移植。

上記記事内のコードが必要な理由

通常の場合、送信者のメールアドレスは[MailItem].SenderEmailAddressで取得できる。

しかし企業内で使われている場合、より具体的にはMicrosoft Exchangeを使用している場合には[MailItem].SenderEmailAddressでは取得できないため（私自身は未確認）。

元となったC#のコード

【方法】メールアイテムの差出人の SMTP アドレスを取得する（180722 リンク切れ）

private string GetSenderSMTPAddress(Outlook.MailItem mail)
{
    string PR_SMTP_ADDRESS =
        @"http://schemas.microsoft.com/mapi/proptag/0x39FE001E";
    if (mail == null)
    {
        throw new ArgumentNullException();
    }
    if (mail.SenderEmailType == "EX")
    {
        Outlook.AddressEntry sender =
            mail.Sender;
        if (sender != null)
        {
            //Now we have an AddressEntry representing the Sender
            if (sender.AddressEntryUserType ==
                Outlook.OlAddressEntryUserType.
                olExchangeUserAddressEntry
                || sender.AddressEntryUserType ==
                Outlook.OlAddressEntryUserType.
                olExchangeRemoteUserAddressEntry)
            {
                //Use the ExchangeUser object PrimarySMTPAddress
                Outlook.ExchangeUser exchUser =
                    sender.GetExchangeUser();
                if (exchUser != null)
                {
                    return exchUser.PrimarySmtpAddress;
                }
                else
                {
                    return null;
                }
            }
            else
            {
                return sender.PropertyAccessor.GetProperty(
                    PR_SMTP_ADDRESS) as string;
            }
        }
        else
        {
            return null;
        }
    }
    else
    {
        return mail.SenderEmailAddress;
    }
}

VBAに移植したコード

'original code  : https://msdn.microsoft.com/ja-jp/library/office/ff184624.aspx
    'iMail As Outlook.MailItem
Private Function GetSenderSMTPAddress(ByVal iMail As Object) As String
    Const PR_SMTP_ADDRESS = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"

    If iMail Is Nothing Then _
        Call Err.Raise(5)

    If iMail.SenderEmailType <> "EX" Then _
        Let GetSenderSMTPAddress = iMail.SenderEmailAddress: _
        Exit Function


    Dim mailSender As Object 'As Outlook.AddressEntry
    Set mailSender = iMail.Sender

    If mailSender Is Nothing Then _
        Exit Function 'return vbNullString


    'Enum value of Outlook.OlAddressEntryUserType for late binding
    Const olExchangeUserAddressEntry = 0, _
          olExchangeRemoteUserAddressEntry = 5

    'Now we have an AddressEntry representing the Sender
    Select Case mailSender.AddressEntryUserType
        Case olExchangeUserAddressEntry, _
             olExchangeRemoteUserAddressEntry

            'Use the ExchangeUser object PrimarySMTPAddress
            Dim exchUser As Object 'As Outlook.ExchangeUser
            Set exchUser = mailSender.GetExchangeUser()

            If exchUser Is Nothing Then _
                Exit Function 'return vbNullString

            Let GetSenderSMTPAddress = exchUser.PrimarySmtpAddress

        Case Else
            Let GetSenderSMTPAddress = _
                    CStr(mailSender.PropertyAccessor.GetProperty(PR_SMTP_ADDRESS))

    End Select

End Function

移植にあたって気をつけた点

早期リターンを意識する

元となったC#のコードはifのネストが深くなっていたため、ややわかりにくく感じた（特に多くの場合使われるreturn mail.SenderEmailAddress;が末尾に来ている点）。

VBA版ではできるだけ早期に返すようにして、ネストの数を多少減らしている。

遅延バインディング対応

元々の質問の条件もあり、参照設定無しで動くようにした。

また、Outlook内で定義されている列挙型に関してはローカル定数として一行で宣言し、参照設定時は簡単にコメントアウトできるようにした。