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

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

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

> 上記内容の参考にしたサイト
> https://msdn.microsoft.com/ja-jp/library/office/ff184624.aspx （180722 リンク切れ）
> [上記サイト Gooleのキャッシュ（180716）](https://webcache.googleusercontent.com/search?q=cache:-YjfZGNM4pUJ:https://msdn.microsoft.com/ja-jp/library/office/ff184624.aspx+&cd=1&hl=ja&ct=clnk&gl=jp "[方法] メール アイテムの差出人の SMTP アドレスを取得する")
> [Outlook 2010 の開発者のための新機能](https://msdn.microsoft.com/ja-jp/library/office/ee692174(v=office.14).aspx#OfficeOutlook2010ComprehensiveObjectModel "Outlook 2010 の開発者のための新機能") 内「差出人の SMTP アドレスの取得」

# この記事の概要

MSDN Office Dev Center 内に存在した

> [【方法】メール アイテムの差出人の SMTP アドレスを取得する](https://msdn.microsoft.com/ja-jp/library/office/ff184624.aspx)（180722 リンク切れ）

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

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

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

しかし企業内で使われている場合、より具体的には[Microsoft Exchange](https://products.office.com/ja-jp/exchange/email "Microsoft Exchange – 生産性を高めるビジネス向け電子メール サービス")を使用している場合には`[MailItem].SenderEmailAddress`では取得できないため（私自身は未確認）。

# 元となったC#のコード

> [【方法】メール アイテムの差出人の SMTP アドレスを取得する](https://msdn.microsoft.com/ja-jp/library/office/ff184624.aspx)（180722 リンク切れ）

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