Làm cách nào để chặn các email gửi đi đến một địa chỉ cụ thể trong Outlook?

Nói chung, Outlook gửi email đến tất cả các địa chỉ email bình thường và không thể chặn gửi email đến một địa chỉ email cụ thể. Tuy nhiên, đôi khi, bạn có thể cần phải ngăn gửi email đến một địa chỉ email cụ thể trong Outlook. Trong trường hợp này, hướng dẫn này sẽ giới thiệu mã VBA để giải quyết tác vụ này.

Chặn các email gửi đi đến một địa chỉ cụ thể bằng mã VBA

Mã VBA sau đây có thể giúp bạn, vui lòng làm như sau:

1. Khởi chạy Outlook, sau đó nhấn và giữ ALT + F11 phím để mở Microsoft Visual Basic cho các ứng dụng cửa sổ.

2. Sau đó, nhấp đúp vào ĐâyOutlookSession từ Dự án-Dự án1 , sau đó sao chép và dán đoạn mã dưới đây vào cửa sổ mã trống:

Mã VBA: Chặn các email gửi đi đến một địa chỉ cụ thể

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
'Updatby ExtendOffice
Dim xMail As Outlook.MailItem
Dim xRecipients As Outlook.Recipients
Dim xContactGroupFound As Boolean
Dim i, n As Long
Dim xRecipient As Outlook.Recipient
Dim xAddress As String
Const PR_SMTP_ADDRESS As String = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"
On Error Resume Next
If Item.Class <> olMail Then Exit Sub
Set xMail = Item
xContactGroupFound = True
Do While xContactGroupFound = True
  Set xRecipients = xMail.Recipients
  xContactGroupFound = False
  For i = xRecipients.Count To 1 Step -1
    If xRecipients(i).AddressEntry.DisplayType <> olUser Then
      For n = 1 To xRecipients(i).AddressEntry.Members.Count
        If xRecipients(i).AddressEntry.Members.Item(n).DisplayType = olUser Then
          xMail.Recipients.Add (xRecipients(i).AddressEntry.Members.Item(n).Address)
        Else
          xMail.Recipients.Add (xRecipients(i).AddressEntry.Members.Item(n).Name)
          xContactGroupFound = True
        End If
      Next
      xRecipients(i).Delete
    End If
  Next i
  xRecipients.ResolveAll
Loop
For Each xRecipient In xRecipients
  xAddress = xRecipient.PropertyAccessor.GetProperty(PR_SMTP_ADDRESS)
  If VBA.Trim(xAddress) = "" Then
    xAddress = xRecipient.Address
  End If
  If xAddress = "" Then    'change this email address to your need
    If MsgBox("Do you want to email to " & Chr(34) & xAddress & Chr(34) & "?", vbExclamation + vbYesNo, "Kutools for Outlook") = vbNo Then
      xRecipient.Delete
    End If
  End If
Next
If xMail.Recipients.Count = 0 Then
  Cancel = True
End If
End Sub

Chú thích: Trong đoạn mã trên, bạn nên thay đổi địa chỉ email thành của riêng bạn.

3. Sau đó, lưu và đóng cửa sổ mã này. Bây giờ, khi gửi email, nếu địa chỉ email cụ thể được tìm thấy trong danh sách người nhận, một thông báo nhắc nhở sẽ xuất hiện như hình minh họa bên dưới. Nhấp chuột Không, địa chỉ email cụ thể sẽ bị xóa ngay lập tức.

4. Sau khi gửi email, bạn có thể kiểm tra người nhận trong Các mục đã gửi thư mục, địa chỉ email nhất định đã bị loại trừ khỏi người nhận, xem ảnh chụp màn hình: