Как да блокирам изходящи имейли до определен адрес в Outlook?

Автор: Xiaoyang Последна промяна: 2022-10-19

Най-общо казано, Outlook изпраща имейли до всички нормални имейл адреси и не може да блокира изпращането на имейли до конкретен имейл адрес. Но понякога може да се наложи да предотвратите изпращането на имейли до конкретен имейл адрес в Outlook. В този случай този урок ще въведе VBA код за решаване на тази задача.

Блокирайте изходящи имейли до конкретен адрес с VBA код

Следният VBA код може да ви направи услуга, моля, направете следното:

1. Стартирайте Outlook, след това задръжте ALT + F11 за да отворите Microsoft Visual Basic за приложения прозорец.

2. След това щракнете два пъти ThisOutlookSession от Проект-Проект1 прозорец и след това копирайте и поставете кода по-долу в прозореца с празен код:

VBA код: Блокирайте изходящи имейли до конкретен адрес

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

Забележка: В горния код трябва да промените имейл адреса на свой собствен.

3. След това запазете и затворете този прозорец с код. Сега, когато изпращате имейл, ако конкретният имейл адрес е намерен в списъка с получатели, ще се появи подканващо съобщение, както е показано на екранната снимка по-долу. Кликнете Не, конкретният имейл адрес ще бъде изтрит незабавно.

4. След като изпратите имейла, можете да проверите неговите получатели в Изпратени елементи папка, определен имейл адрес е изключен от получателите, вижте екранна снимка: