KutoolsforOffice — 一套方案，五大工具。事半功倍。

如何在 Outlook 回复邮件时，自动将邮件中的联系人添加到通讯录？

作者Kelly修改日期

在回复邮件时，您可能希望自动将发件人或收件人添加到 Outlook 联系人中，这不仅能节省时间，还能确保重要的联系人信息不会丢失。虽然 Outlook 本身不支持在回复邮件时自动添加联系人，但接下来我将为您介绍两种实现自动从邮件添加联系人的方法，其中包括使用 Kutools for Outlook 的功能。

通过 VBA 在 Outlook 回复邮件时自动添加联系人

使用 Kutools 将选中项目的多个发件人与收件人批量添加添加到联系人

通过 VBA 在 Outlook 回复邮件时自动添加联系人

本 VBA 可在您回复 Outlook 邮件时，自动将发件人及所有收件人保存为新联系人。请按照以下步骤操作：

1. 按下 Alt+F11 组合键，即可打开 Microsoft Visual Basic for Applications 窗口。

2. 展开 Project 1，双击 ThisOutlookSession 以打开，然后将以下 VBA 代码粘贴到 ThisOutlookSession 窗口中。请参见截图：

使用 VBA 回复 Outlook 邮件时自动添加联系人功能的屏幕截图

VBA：在 Outlook 回复邮件时自动添加联系人

Public WithEvents xExplorer As Outlook.Explorer
Public WithEvents xMailItem As Outlook.MailItem
Sub Application_Startup()
Set xExplorer = Outlook.Application.ActiveExplorer
End Sub

Private Sub xExplorer_SelectionChange()
On Error Resume Next
Set xMailItem = xExplorer.Selection.Item(1)
End Sub

Private Sub xMailItem_Reply(ByVal Response As Object, Cancel As Boolean)
Dim xNameSpace As NameSpace
Dim xSenderAddress As String
Dim xContactItems As Outlook.Items
Dim i, k As Long
Dim xFilterAddress As String
Dim xContact As Outlook.ContactItem
Dim xNewContact As Outlook.ContactItem
Dim Arr() As String
Dim ArrName() As String
Dim xArrCount As Integer
On Error Resume Next
ReDim Arr(xMailItem.Recipients.Count + 1)
ReDim ArrName(xMailItem.Recipients.Count + 1)
xSenderAddress = xMailItem.SenderEmailAddress
Arr(0) = xSenderAddress
ArrName(0) = xMailItem.SenderName
For i = LBound(Arr) + 1 To UBound(Arr) - 1
Arr(i) = xMailItem.Recipients.Item(i).Address
ArrName(i) = xMailItem.Recipients.Item(i).Name
Next i
Set xNameSpace = Outlook.Application.GetNamespace("MAPI")
Set xContactItems = xNameSpace.GetDefaultFolder(olFolderContacts).Items
For i = LBound(Arr) To UBound(Arr) - 1
For k = 1 To 3
xFilterAddress = "[Email" & k & "Address] = " & Arr(i)
Set xContact = xContactItems.Find(xFilterAddress)
If Not (xContact Is Nothing) Then
Exit For
End If
Next k
If xContact Is Nothing Then
Set xNewContact = Outlook.Application.CreateItem(olContactItem)
With xNewContact
.FullName = ArrName(i)
.Email1Address = Arr(i)
.Categories = "From Email"
.Save
End With
End If
Next i
End Sub

3. 保存 VBA 代码后，重启您的 Microsoft Outlook。

从现在起，每当您在 Outlook 中回复邮件时，邮件的发件人及所有收件人都会自动保存为新联系人，存储在默认电子邮件帐户的默认联系人文件夹中。

使用 Kutools 将选中项目的多个发件人与收件人批量添加添加到联系人

Kutools for Outlook 的将所选邮件的发件人及多个收件人添加至联系人工具，大大简化了添加联系人的操作。此功能让您能够批量从一封或多封邮件中添加联系人。

👉 在 Outlook 中更高效地工作！下载 Kutools for Outlook，体验 100+ 项省时功能，助力提升办公效率——30 天免费试用！

步骤 1. 下载并安装 Kutools for Outlook。接着，进入已发送邮件文件夹（或其他相关文件夹），选择您希望将发件人和收件人添加到联系人的邮件。

步骤 2. 点击 Kutools > 添加联系人 > 将所选邮件发件人和多个收件人添加至联系人。

doc-点击添加到联系人

步骤 3. 在“从邮件中添加联系人”对话框中，

  1. 选择联系人文件夹：请选择要保存新建联系人的文件夹。

  2. 选择地址：默认会选中所有尚未存在的地址。请仔细核对列表，取消不需要添加的地址勾选，确保信息准确无误。

  3. 单击确定：确认您的选择，即可将联系人保存到所选文件夹。

    doc-添加到联系人

步骤 4. 弹出对话框后，将显示添加成功的联系人数量。点击确定即可关闭对话框。

注意：重复的邮箱地址仅会添加到联系人一次。
doc-提醒

相关文章

最佳办公效率工具

体验全新 Kutools for Outlook，畅享 100+ 强大功能！立即点击下载，不容错过！

🤖KUTOOLS AI：采用先进 AI 技术，轻松处理邮件，涵盖回复、摘要、优化、扩展、翻译及撰写等功能。

📧 邮件自动化：自动答复（支持 POP 和 IMAP）/定时发送邮件/发送邮件时按规则自动抄送密送/自动转发（高级规则）/自动添加称呼/自动将多收件人邮件拆分为单独信息……

📨 邮件管理：撤回邮件/按主题等条件拦截诈骗邮件/删除重复邮件/高级搜索/整合文件夹……

📁 附件增强：批量保存/批量分离/批量压缩/自动保存/自动拆离/自动压缩……

🌟 界面魔法：😊更多美观时尚表情/重要邮件到达时提醒您/最小化 Outlook 而不是直接关闭……

👍 一键精彩功能：带附件全部答复/反钓鱼邮件/🕘显示发送者当前时间时区……

👩🏼‍🤝‍👩🏻 联系人与日历：批量从选定邮件中提取添加联系人/将联系人组拆分为个人组/移除生日提醒……

在您的首选语言中畅享 Kutools —— 支持英语、西班牙语、德语、法语、中文等 40 多种语言！

一键解锁 Kutools for Outlook，告别等待，立即下载，让效率倍增！

kutools for outlook 功能1kutools for outlook 功能2

🚀 一键下载 — 即可获取全部 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