Skip to main content

Kutools for Office — 一套工具,五種功能。完成更多工作。

如何在Outlook回覆郵件時自動新增聯絡人?

Author Kelly Last modified

在回覆郵件時,您可能希望自動將寄件者或收件人新增到您的Outlook聯絡人中。這樣可以節省時間並確保您不會遺失重要的聯絡資訊。雖然Outlook本身不支援在回覆時自動新增聯絡人,但我將向您介紹兩種方法來從郵件中自動新增聯絡人,其中包括Kutools for Outlook的功能。

使用VBA在Outlook回覆郵件時自動新增聯絡人

使用Kutools批量將多個寄件者和收件人從選中的郵件新增至聯絡人


使用VBA在Outlook回覆郵件時自動新增聯絡人

此VBA將在您於Outlook中回覆郵件時,自動將該郵件的寄件者和所有收件人作為新聯絡人新增。請按照以下步驟操作:

1. 按下 Alt + F11 鍵以打開Microsoft Visual Basic for Applications視窗。

2. 展開Project1,然後雙擊ThisOutlookSession以打開它,接著將以下VBA代碼粘貼到ThisOutlookSession視窗中。參見截圖:

the screenshot of auto adding contacts from an outlook email when replying with vba

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通過其「將選中郵件的寄件者和多位收件人新增至聯絡人」功能簡化了新增聯絡人的過程。這允許您從一封或多封郵件中批量新增聯絡人。

 👉 Kutools for Outlook 現在有免費版本,其 70+ 功能終身免費。立即下載免費版本

步驟1. 下載並安裝Kutools for Outlook。然後,進入已傳送郵件資料夾(或其他資料夾),選擇您想將寄件者和收件人新增至聯絡人的郵件。

步驟2. 點擊 Kutools > 新增聯絡人 > 將選中郵件的寄件者和多位收件人新增至聯絡人。

doc-click-add-to-contacts

步驟3. 在「從郵件新增聯絡人」對話框中,

  1. 選擇聯絡人資料夾:選擇您要保存新聯絡人的資料夾。

  2. 選擇地址:默認情況下,除現有地址外的所有地址都已被選中。檢查列表並取消勾選您不想新增的地址。

  3. 點擊確定:確認您的選擇並將聯絡人保存到所選資料夾中。

    doc-add-to-contacts

步驟4. 將出現一個對話框,顯示成功新增的聯絡人數量。點擊確定關閉對話框。

注意:重複的郵件地址只會被新增一次。
doc-reminder

相關文章


最佳辦公室生產力工具

最新消息:Kutools for Outlook 推出免費版本!

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

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

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

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

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

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

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

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

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

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

kutools for outlook features1 kutools for outlook features2

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

強力推薦:Kutools for Office(5合1)

一鍵下載五個安裝程式,包括 Kutools for Excel, Outlook, Word, PowerPointOffice Tab Pro 立即下載!

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