如何在 Outlook 中獲取一封或多封郵件的寄件人郵件地址？

您是否曾經嘗試從 Outlook 中一封或多封收到的郵件的「寄件者」欄位中提取郵件地址？本文提供了一段 VBA 程式碼，幫助您完成此任務。

從一封或多封郵件中獲取寄件人的郵件地址

請執行以下 VBA 程式碼，以從 Outlook 中的一封或多封已接收郵件的「寄件者」欄位中提取郵件地址。

1. 打開郵件資料夾，選擇您要獲取寄件人郵件地址的郵件。按下 Alt + F11 鍵打開 Microsoft Visual Basic for Applications 視窗。

注意：若要選擇多封郵件，請按住 Ctrl 鍵，然後逐一選擇郵件。

2. 在 Microsoft Visual Basic for Applications 視窗中，點擊 插入 > 模組，然後將以下 VBA 程式碼複製到模組（程式碼）視窗中。

VBA 程式碼：從一封或多封郵件中提取寄件人的郵件地址

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 對話框，列出所有所選郵件的寄件人郵件地址。

注意：

5. 點擊 是 按鈕後，會彈出一個瀏覽資料夾對話框。請選擇一個資料夾保存文件並點擊 確定 按鈕。

6. 最後，會彈出一個 Kutools for Outlook 對話框，告訴您導出文件的路徑。點擊 確定 關閉它。

7. 前往保存導出文件的資料夾，並打開名為 Address 的 .txt 文件，查看所選郵件的寄件人郵件地址。

---

最佳辦公室生產力工具

最新消息：Kutools for Outlook 推出免費版本！

體驗全新 Kutools for Outlook，超過100項精彩功能！立即下載！

🤖 Kutools AI ：採用先進的AI技術輕鬆處理郵件，包括答覆、摘要、優化、擴充、翻譯及撰寫郵件。

📧 郵件自動化：自動回覆（支援POP及IMAP） / 排程發送郵件 / 發送郵件時根據規則自動抄送密送 / 自動轉發（高級規則） / 自動添加問候語 / 自動分割多收件人郵件為個別郵件 ...

📨 郵件管理：撤回郵件 / 根據主題等方式阻止詐騙郵件 / 刪除重複郵件 / 高級搜索 / 整合文件夾 ...

📁 附件專業工具：批量保存 / 批量拆離 / 批量壓縮 / 自動保存 / 自動拆離 / 自動壓縮 ...

🌟 介面魔法：😊更多精美與酷炫表情符號 /重要郵件來臨時提醒 / 最小化 Outlook 而非關閉 ...

👍 一鍵便利：帶附件全部答復 / 防詐騙郵件 / 🕘顯示發件人時區 ...

👩🏼‍🤝‍👩🏻 聯絡人與日曆：從選中郵件批量添加聯絡人 / 分割聯絡人組為個別組 / 移除生日提醒 ...

以您偏好的語言使用 Kutools，支援英語、西班牙語、德語、法語、中文及超過40種其他語言！

只需點擊一次，即可立即解鎖 Kutools for Outlook。別等了，現在下載提升您的工作效率！

Kutools for Outlook 功能清單立即下載前往購買

🚀 一鍵下載 — 獲取全部 Office 插件

強力推薦：Kutools for Office（5合1）

一鍵下載五個安裝程式，包括 Kutools for Excel, Outlook, Word, PowerPoint及 Office Tab Pro。 立即下載！

• ✅ 一鍵便利：一次操作即可下載全部五套安裝包。
• 🚀 隨時處理任何 Office 任務：安裝您需求的插件，隨時隨地。
• 🧰 包含：Kutools for Excel / Kutools for Outlook / Kutools for Word / Office Tab Pro / Kutools for PowerPoint

套件介紹 ⬇下載套件 💳 購買套件