KutoolsforOffice — 一套方案,五大工具。事半功倍。三月特賣:20% 折扣

在 Outlook 中回覆電子郵件時,如何自動將寄件人新增至聯絡人?

作者Kelly修改日期

回覆電子郵件時,您或許希望自動將寄件者或收件者加入 Outlook 聯絡人,不僅節省時間,更能確保重要的聯絡資訊不會遺失。雖然 Outlook 本身不支援在回覆郵件時自動新增聯絡人,但我將為您介紹兩種方法,協助您從電子郵件中自動新增聯絡人,其中包含一項 Kutools for Outlook 的實用功能。

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

使用 Kutools 將多個寄件者與收件者自選中項目批次批量添加至聯絡人


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

當您在 Outlook 中回覆電子郵件時,此 VBA 會自動將該郵件的寄件者與所有收件者新增為聯絡人。請依照下列步驟操作:

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-click-add-to-contacts

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

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

  2. 選取地址:預設情況下,系統會自動選取所有地址(不含已存在的地址)。請仔細檢閱清單,並取消勾選您不希望新增的項目。

  3. 按一下「確定」:確認您的選擇,並將聯絡人儲存至所選資料夾。

    doc-add-to-contacts

步驟 4. 系統將顯示一個對話方塊,說明已成功新增的聯絡人數量。按一下確定以關閉對話方塊。

注意:重複的郵箱地址僅會新增一次至聯絡人。
doc-reminder

相關文章


最佳 Office 生產力工具

體驗全新 Kutools for Outlook,內含 100+ 項超強功能!立即點擊下載!

🤖KUTOOLS AI運用先進 AI 技術,輕鬆處理電子郵件——無論是回覆、摘要、優化、擴充、翻譯還是撰寫郵件,通通一鍵搞定!

📧 郵件自動化自動答覆(支援 POP 與 IMAP)預約寄送郵件寄信時依規則自動抄送密送自動轉發(高級規則)自動加入問候語自動將多收件人郵件拆分為個別訊息……

📨 郵件管理撤回郵件依主旨等條件封鎖詐騙郵件刪除重複郵件高級搜尋整合文件夾……

📁 附件專業版批次儲存批次解除附加批次壓縮自動保存自動拆離自動壓縮……

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

👍 一鍵奇蹟帶附件全部答復防釣魚郵件🕘顯示發送者當前時間時區……

👩🏼‍🤝‍👩🏻 聯絡人與行事曆從選取的郵件中批次新增聯絡人將聯繫人組拆分為個別群組移除生日提醒……

用您的慣用語言暢享 Kutools — 完整支援英文、西班牙文、德文、法文、中文等 40 多種語言!

立即一鍵解鎖 Kutools for Outlook!別再等待,馬上下載,全面提升工作效率!

kutools for outlook features1kutools 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