如何從 Outlook 中的一封或多封電子郵件中取得寄件者的郵箱地址?
您是否曾想從 Outlook 中一封或多封已收到郵件的「寄件者」欄位提取電子郵件地址?本文提供一段 VBA 程式碼,助您輕鬆完成這項任務!
從 Outlook 中的一封或多封電子郵件取得寄件者的郵箱地址
請執行下列 VBA 程式碼,從 Outlook 中一封或多封已接收郵件的「寄件者」欄位提取郵箱地址。
1. 開啟電子郵件資料夾,選取一封您想取得寄件者郵箱地址的郵件,然後按下 Alt+F11 鍵,立即開啟 Microsoft Visual Basic for Applications 視窗!
提示:若要選取多封郵件,請按住 Ctrl 鍵,再逐一點選郵件。
2. 在 Microsoft Visual Basic for Applications 視窗中,點擊插入> 模組,並將下列 VBA 程式碼複製到模組(程式碼)視窗中。

VBA 程式碼:從 Outlook 中的一封或多封電子郵件提取寄件者的郵箱地址
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. 在 參考 – Project 1 對話方塊中,點擊工具> 參考,然後勾選 Microsoft Scripting Runtime 核取方塊。

4. 按下 F5 鍵以執行程式碼,隨即會彈出一個 Kutools for Outlook 對話方塊,列出所有所選郵件的寄件者信箱地址。
提示:

5. 點擊是按鈕後,將彈出一個瀏覽資料夾對話方塊。請選擇要儲存檔案的資料夾,然後點擊確定按鈕。

6. 最後將彈出一個 Kutools for Outlook 對話方塊,告知您匯出檔案的儲存路徑。點擊確定即可關閉該對話方塊。

7. 前往儲存匯出檔案的資料夾,開啟檔名為 Address、副檔名為 。文本文檔的檔案,即可查看所選郵件的寄件者郵箱地址。

最佳 Office 生產力工具
體驗全新 Kutools for Outlook,內含 100+ 項超強功能!立即點擊下載!
🤖KUTOOLS AI:運用先進 AI 技術,輕鬆處理電子郵件——無論是回覆、摘要、優化、擴充、翻譯還是撰寫郵件,通通一鍵搞定!
📧 郵件自動化:自動答覆(支援 POP 與 IMAP)/預約寄送郵件/寄信時依規則自動抄送密送/自動轉發(高級規則)/自動加入問候語/自動將多收件人郵件拆分為個別訊息……
📨 郵件管理:撤回郵件/依主旨等條件封鎖詐騙郵件/刪除重複郵件/高級搜尋/整合文件夾……
📁 附件專業版:批次儲存/批次解除附加/批次壓縮/自動保存/自動拆離/自動壓縮……
🌟 介面魔法:😊更多精美酷炫表情符號/重要郵件來到時提醒您/最小化 Outlook 而非關閉……
👍 一鍵奇蹟:帶附件全部答復/防釣魚郵件/🕘顯示發送者當前時間時區……
👩🏼🤝👩🏻 聯絡人與行事曆:從選取的郵件中批次新增聯絡人/將聯繫人組拆分為個別群組/移除生日提醒……
用您的慣用語言暢享 Kutools — 完整支援英文、西班牙文、德文、法文、中文等 40 多種語言!
立即一鍵解鎖 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