Note: The other languages of the website are Google-translated. Back to English

Làm cách nào để tự động thêm liên hệ từ email khi trả lời trong Outlook?

Trong Outlook 2010, bạn có thể bật Các sự liên hệ được đề xuất và tự động thêm người nhận làm địa chỉ liên hệ mới. Tuy nhiên, điều này Các sự liên hệ được đề xuất tính năng không được hỗ trợ trong Outlook 2013 và 2016. Ở đây, tôi sẽ giới thiệu một VBA để tự động thêm người gửi và người nhận email làm địa chỉ liên hệ mới khi trả lời trong Outlook.

Tự động thêm liên hệ từ email Outlook khi trả lời bằng VBA

Tab Office - Cho phép Chỉnh sửa và Duyệt theo Tab trong Office và Giúp Công việc Dễ dàng hơn Nhiều ...
Kutools cho Outlook - Mang đến 100 tính năng nâng cao mạnh mẽ cho Microsoft Outlook
  • Auto CC / BCC bởi các quy tắc khi gửi email; Tự động chuyển tiếp Nhiều Email theo quy tắc; Tự động trả lời không có máy chủ trao đổi và các tính năng tự động khác ...
  • Cảnh báo BCC - hiển thị tin nhắn khi bạn cố gắng trả lời tất cả nếu địa chỉ mail của bạn có trong danh sách BCC; Nhắc nhở khi thiếu tệp đính kèmvà các tính năng nhắc nhở khác ...
  • Trả lời (Tất cả) Với Tất cả Tệp đính kèm trong cuộc trò chuyện qua thư; Trả lời nhiều email cùng một lúc; Tự động thêm lời chào khi trả lời; Tự động Thêm Ngày & Giờ vào chủ đề ...
  • Công cụ đính kèm: Tự động tách, Nén tất cả, Đổi tên tất cả, Tự động lưu tất cả ... Báo cáo nhanh, Đếm Thư đã Chọn, Xóa Thư và Địa chỉ Liên hệ Trùng lặp ...
  • Hơn 100 tính năng nâng cao sẽ giải quyết hầu hết các vấn đề của bạn trong Outlook 2021 - 2010 hoặc Office 365. Tính năng đầy đủ Bản dùng thử miễn phí 60 ngày.

Tự động thêm liên hệ từ email Outlook khi trả lời bằng VBA

VBA này sẽ tự động thêm người gửi và tất cả người nhận email làm địa chỉ liên hệ mới khi bạn trả lời email trong Outlook. Vui lòng làm như sau:

1. nhấn Khác + F11 để mở cửa sổ Microsoft Visual Basic for Applications.

2. Mở rộng Project1 và nhấp đúp vào ĐâyOutlookSession để mở nó, rồi dán mã VBA bên dưới vào cửa sổ ThisOutlookSession. Xem ảnh chụp màn hình:

VBA: Tự động Thêm Liên hệ từ email khi trả lời trong 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. Lưu mã VBA và khởi động lại Microsoft Outlook của bạn.

Từ bây giờ, khi bạn trả lời email trong Outlook, người gửi và tất cả người nhận của email này sẽ tự động được lưu dưới dạng liên hệ mới vào thư mục liên hệ mặc định của tài khoản email mặc định.


Bài viết liên quan


Kutools cho Outlook - Cung cấp 100 Tính năng Nâng cao cho Outlook và Làm cho Công việc Dễ dàng hơn Nhiều!

  • Auto CC / BCC bởi các quy tắc khi gửi email; Tự động chuyển tiếp Nhiều Email theo tùy chỉnh; Tự động trả lời không có máy chủ trao đổi và các tính năng tự động khác ...
  • Cảnh báo BCC - hiển thị tin nhắn khi bạn cố gắng trả lời tất cả nếu địa chỉ thư của bạn có trong danh sách BCC; Nhắc nhở khi thiếu tệp đính kèmvà các tính năng nhắc nhở khác ...
  • Trả lời (Tất cả) Với Tất cả Tệp đính kèm trong cuộc trò chuyện qua thư; Trả lời nhiều email trong vài giây; Tự động thêm lời chào khi trả lời; Thêm Ngày vào chủ đề ...
  • Công cụ Tệp đính kèm: Quản lý Tất cả Tệp đính kèm trong Tất cả Thư, Tự động tách, Nén tất cả, Đổi tên tất cả, Lưu tất cả ... Báo cáo nhanh, Đếm thư đã chọnhữu ích. Cảm ơn !
  • Email rác mạnh mẽ Theo phong tục; Xóa thư và liên hệ trùng lặphữu ích. Cảm ơn ! Cho phép bạn làm việc thông minh hơn, nhanh hơn và tốt hơn trong Outlook.
shot kutools triển vọng tab kutools 1180x121
shot kutools triển vọng kutools plus tab 1180x121
 
Nhận xét (1)
Chưa có xếp hạng. Hãy là người đầu tiên xếp hạng!
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Xin chào, cảm ơn vì mã này.
Nhưng nó sao chép (ít nhất là trong trường hợp của tôi) các số liên lạc nhiều lần khi tôi viết thư cho họ. Bất kỳ ý tưởng?
Nhân tiện, trong tùy chọn triển vọng, hộp "tìm kiếm các bản sao khi lưu một liên hệ mới" được chọn.
Không có bình luận nào được đăng ở đây
Để lại ý kiến ​​của bạn
Đăng với tư cách khách
×
Đánh giá bài viết này:
0   Nhân vật
Các vị trí được đề xuất

Kết nối với chúng tôi

Bản quyền © 2009 - www.extendoffice.com. | Đã đăng ký Bản quyền. cung cấp bởi ExtendOffice. | BẢN ĐỒ CHI NHÁNH
Microsoft và logo Office là các nhãn hiệu hoặc nhãn hiệu đã đăng ký của Microsoft Corporation tại Hoa Kỳ và / hoặc các quốc gia khác.
Được bảo vệ bởi Sectigo SSL