Outlookのメッセージファイル（.msg）から送信元アドレスを取得したい

Question

前提・実現したいこと

初めまして。
VBA初心者です。

ExcelのVBAで、OUTLOOL2013のメッセージファイル（.msg）から送信元アドレスを取得しようとしています。
今回は受信トレイのメールからではなく、ローカルの任意の場所にコピーしたメッセージファイル（.msg）からデータを取り出したいです。

該当のソースコード

Sub get_msg()


Dim OL  As Object
Dim msg As Object
Dim intNo As Integer
Dim strFileName As String
Dim strOutFileName As String
Dim SaveFolderPath As String
Dim AttFile_excel As String
Dim AttFile_text As String

' テキストを出力するファイルを設定(※要変更)
strFileName = "C:\Temp\明日の予定について.msg"
' テキストを出力するファイルを設定(※要変更)
strOutFileName = "C:\Temp\sample.txt"
' 添付ファイルの保存先フォルダ(※要変更)
SaveFolderPath = "C:\Temp\"
'メールに添付されているエクセルファイル
AttFile_excel = "C:\Temp\サンプルエクセル.xlsx"
'メールに添付されているテキストファイル
AttFile_text = "C:\Temp\サンプルテキスト.txt"

'Outlookのアプリケーションオブジェクトを作成する
Set OL = CreateObject("Outlook.Application")
Set msg = OL.CreateItemFromTemplate(strFileName)
    

intNo = FileSystem.FreeFile()           ' フリーファイルNoを取得
Open strOutFileName For Output As #intNo   ' 上書きモードでファイルをオープン
    

    Print #intNo, "SentOnBehalfOfName: " & msg.SentOnBehalfOfName
    Print #intNo, "SenderName: " & msg.SenderName
    Print #intNo, "ReceivedOnBehalfOfName: " & msg.ReceivedOnBehalfOfName
    Print #intNo, "ReplyRecipientNames: " & msg.ReplyRecipientNames
    Print #intNo, "To: " & msg.To
    Print #intNo, "CC: " & msg.CC
    Print #intNo, "BCC: " & msg.Bcc
    Print #intNo, "Subject: " & msg.Subject
    Print #intNo, "Body: " & msg.Body
    
Close #intNo                            ' ファイルをクローズ

Set msg = Nothing
Set OL = Nothing

End Sub

試したこと

[実行結果]
SentOnBehalfOfName: Yamada, Taro/山田 太郎　 ←★ここをメールアドレスとして取得したい
SenderName: Yamada, Taro/山田 太郎
ReceivedOnBehalfOfName: Suzuki, Hanako/鈴木 花子
ReplyRecipientNames:
To: Suzuki, Hanako/鈴木 花子
CC:
BCC:
Subject: 明日の予定について
Body:
担当者様

お世話になっております。
明日の出発時間は何時でしょうか。

以下のようなプロパティを利用しても、メールアドレスではなく名前に変換されてしまいます。
SentOnBehalfOfName
Sender

SenderEmailAddressを使用しても、以下のように組織にあるExchangeサーバの情報しか取れません。
/O=xxxx EXCHANGE ORGANIZATION/OU=EXCHANGE ADMINISTRATIVE GROUP (FYDIBOHF23SPDLT)/CN=RECIPIENTS/CN=YAMADA.TARO018

どうすれば、名前として変換されているメールアドレスを取得できるでしょうか。
プロパティについては、以下MSDNを参考にしています。
MailItem メンバー (Outlook)

補足情報（FW/ツールのバージョンなど）

Comments

[m.ts10806]

現在組まれているソースコードをご提示ください。また、文章と引用・関連情報などはコードブロックや引用符などマークダウンを使って明確にわけるようにしていただくと読みやすくなりますのでご活用ください。 https://teratail.com/help#about-markdown

[m.ts10806]

おそらく編集画面にリアルタイムプレビューが出ているのでそちらを見ながら更新していただけると・・・。メール文章のところはコードブロック ``` で囲うほうがいいかもしれませんね。見出しになってますし。

Answer 1

outlook Exchange SenderEmailAddressのキーワードでGoogle検索したところ、
以下のページが見つかりました。

【方法】メール アイテムの差出人の SMTP アドレスを取得する

ただ、例がC#のコードだったため、遅延バインド版VBAに書き換えてみました。

当方にはExchangeサーバの環境が無いため動作が確認できていませんが、よろしければお試しください。

'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

Comments

[fishStory]

ご回答ありがとうございます。
上記Functionの呼び方としては、以下であっているでしょうか？

’Dim sendmailaddress As String’
’sendmailaddress = GetSenderSMTPAddress msg’

上記の呼び方ですと、構文エラーが出てしますのですが…

[imihito]

VBAのプロシージャの呼び出し方法ですが
返り値を使用しない場合は「プロシージャ名 引数1, 引数2, …」（カッコ不要）
返り値を使用する場合、または「Call」を付けた場合は「～ プロシージャ名(引数1, 引数2, …)」（カッコ必要）
となります（初心者には紛らわしいと思います）。

今回は「GetSenderSMTPAddress」の「返り値を使用する場合」ですので引数をカッコで括る必要があります。
つまり、「 sendmailaddress = GetSenderSMTPAddress(msg) 」
とカッコをつけて呼び出す必要があります。