Outlook で1 通または複数のメールから送信者のメールアドレスを取得するには、どうすればよいですか？

著者Siluvia変更日2024-09-13

Outlook で受信した1 通または複数のメールの「差出人」フィールドからメールアドレスを抽出しようとしたことはありませんか？この記事では、その作業を効率的にサポートする VBA コードをご紹介します。

Outlook で1 通または複数のメールから送信者のメールアドレスを取得する

Outlook で受信した1 通または複数のメールの「差出人」フィールドからメールアドレスを抽出するには、以下の VBA コードを実行してください。

1。メールフォルダーを開き、送信者のメールアドレスを取得したいメールを選択します。次に、Alt+F11キーを押して、Microsoft Visual Basic for Applicationsウィンドウを開きます。

ヒント：複数のメールを選択するには、Ctrlキーを押しながら、メールを1 通ずつ選択してください。

2。Microsoft Visual Basic for Applicationsウィンドウで、挿入 > モジュールをクリックし、次の VBA コードをモジュール（コード）ウィンドウにコピーしてください。

VBA コード：Outlook で1 通または複数のメールから送信者のメールアドレスを抽出する

Sub GetSmtpAddressOfSelectionEmail()
  Dim xExplorer As Explorer
  Dim xSelection As Selection
  Dim xItem As Object
  Dim xMail As MailItem
  Dim xAddress As String
  Dim xFldObj As Object
  Dim FilePath As String
  Dim xFSO As Scripting.FileSystemObject
  On Error Resume Next
  Set xExplorer = Application.ActiveExplorer
  Set xSelection = xExplorer.Selection
  For Each xItem In xSelection
    If xItem.Class = olMail Then
      Set xMail = xItem
      xAddress = xAddress & VBA.vbCrLf & "  " & GetSmtpAddress(xMail)
    End If
  Next
  If MsgBox("Sender SMTP Address is: " & xAddress & vbCrLf & vbCrLf & "Do you want to export the address list to a txt file? ", vbYesNo, "Kutools for Outlook") = vbYes Then
    Set xFldObj = CreateObject("Shell.Application").BrowseforFolder(0, "Select a Folder", 0, 16)
    Set xFSO = New Scripting.FileSystemObject
    If xFldObj Is Nothing Then Exit Sub
    FilePath = xFldObj.Items.Item.Path & "\Address.txt"
    Close #1
    Open FilePath For Output As #1
    Print #1, "Sender SMTP Address is: " & xAddress
    Close #1
    Set xFSO = Nothing
    Set xFldObj = Nothing
    MsgBox "Address list has been exported to：" & FilePath, vbOKOnly + vbInformation, "Kutools for Outlook"
  End If
End Sub
Function GetSmtpAddress(Mail As MailItem)
  Dim xNameSpace As Outlook.NameSpace
  Dim xEntryID As String
  Dim xAddressEntry As AddressEntry
  Dim PR_SENT_REPRESENTING_ENTRYID As String
  Dim PR_SMTP_ADDRESS As String
  Dim xExchangeUser As exchangeUser
  On Error Resume Next
  GetSmtpAddress = ""
  Set xNameSpace = Application.Session
  If Mail.sender.Type <> "EX" Then
    GetSmtpAddress = Mail.sender.Address
  Else
    PR_SENT_REPRESENTING_ENTRYID = "http://schemas.microsoft.com/mapi/proptag/0x00410102"
    xEntryID = Mail.PropertyAccessor.BinaryToString(Mail.PropertyAccessor.GetProperty(PR_SENT_REPRESENTING_ENTRYID))
    Set xAddressEntry = xNameSpace.GetAddressEntryFromID(xEntryID)
    If xAddressEntry Is Nothing Then Exit Function
    If xAddressEntry.AddressEntryUserType = olExchangeUserAddressEntry Or xAddressEntry.AddressEntryUserType = olExchangeRemoteUserAddressEntry Then
      Set xExchangeUser = xAddressEntry.GetExchangeUser()
      If xExchangeUser Is Nothing Then Exit Function
      GetSmtpAddress = xExchangeUser.PrimarySmtpAddress
    Else
      PR_SMTP_ADDRESS = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"
      GetSmtpAddress = xAddressEntry.PropertyAccessor.GetProperty(PR_SMTP_ADDRESS)
    End If
  End If
End Function

3。ツール>参照設定をクリックし、表示される参照設定 – Project1ダイアログボックス内で、Microsoft Scripting Runtimeのチェックボックスをオンにします。

4。F5キーを押してコードを実行すると、Kutools for Outlookのダイアログボックスが表示され、選択したメールのすべての送信者のメールアドレスが一覧表示されます。

ヒント：

アドレスリストを TXT ファイルにエクスポートする必要がある場合は、「はい」ボタンをクリックします。

または「いいえ」ボタンをクリックして処理を終了します。

5。「はい」ボタンをクリックすると、フォルダーの参照ダイアログボックスが表示されます。ファイルを保存するフォルダーを選択して、「OK」ボタンをクリックしてください。

6。最後に、「Kutools for Outlook」ダイアログボックスが表示され、エクスポートされたファイルの保存先パスが通知されます。「OK」をクリックして閉じてください。

7。エクスポートされたファイルが保存されているフォルダーに移動し、Addressという名前の.TXT ファイルを開いて、選択したメールの送信者のメールアドレスを確認します。

最高の Office 生産性ツール

まったく新しいKutools for Outlook を、100 以上の驚きの機能とともに体験しましょう！今すぐダウンロード！

🤖KUTOOLS AI：高度な AI 技術を活用して、メールの返信、要約、最適化、拡張、翻訳、作成など、あらゆる操作をラクラクこなします。

📧メール自動化：自動返信（POP および IMAP 対応）/メールのスケジュール送信/メール送信時にルールに基づいて自動 CC/BCC/自動転送（高度なルール）/自動で挨拶文を追加/複数の宛先を持つメールを個別のメッセージに自動分割...

📨メール管理：メールの取り消し/件名などを基準に詐欺メールをブロック/重複したメールを削除/高度な検索/フォルダーを整理...

📁添付ファイルプロ：一括保存/一括分離/一括圧縮/自動保存/自動的に切り離す/自動圧縮...

🌟インターフェースの魅力：😊さらに美しくクールな絵文字を多数収録/重要なメールが届いた際に通知/Outlook を閉じる代わりに最小化...

👍ワンクリックの驚き：全員に【Attachment】付きで返信/フィッシングメール対策/🕘送信者の現在時刻ゾーンを表示...

👩🏼‍🤝‍👩🏻連絡先とカレンダー：選択したメールから連絡先を追加を一括登録/連絡先グループを個別のグループに分割/誕生日のリマインダーを削除...

Kutools はお好みの言語でお使いいただけます！英語、スペイン語、ドイツ語、フランス語、中国語をはじめ、40 以上の言語をサポートしています！

ワンクリックでKutools for Outlook の機能を即解放！今すぐダウンロードして、効率を飛躍的にアップさせましょう！

Kutools for Outlook の機能一覧今すぐダウンロード購入ページへ

🚀 ワンクリックダウンロード — Office アドインをすべて入手

強く推奨：Kutools for Office（5-in-1）

ワンクリックで5 つのインストーラーを 一括ダウンロード！ ―Kutools for Excel、Outlook、Word、PowerPointおよびOffice Tab Pro。今すぐダウンロード！

✅ワンクリックで簡単操作：5 つのセットアップパッケージをたった1 回のクリックで一括ダウンロードできます。
🚀どんな Office 作業にも対応可能：必要なときに、必要なアドインをすぐインストールできます。
🧰含まれるもの：Kutools for Excel / Kutools for Outlook / Kutools for Word / Office Tab Pro / Kutools for PowerPoint

スイートについて ⬇ スイートをダウンロード 💳 スイートを購入