如何在 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 的文本文档，即可查看所选邮件的发件人邮箱地址。

---

最佳办公效率工具

体验全新 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

关于套件⬇ 下载套件💳 购买套件