[VBA]Outlook.MailItemから送信者のメールアドレスを取得する

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

他のサイト
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に移植したコード

```vb
'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内で定義されている列挙型に関してはローカル定数として一行で宣言し、参照設定時は簡単にコメントアウトできるようにした。