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

如何阻止外發電子郵件到 Outlook 中的特定地址?

一般來說,Outlook 會向所有正常的電子郵件地址發送電子郵件,並且無法阻止向特定電子郵件地址發送電子郵件。 但是,有時,您可能需要阻止將電子郵件發送到 Outlook 中的特定電子郵件地址。 在這種情況下,本教程將介紹用於解決此任務的 VBA 代碼。


使用 VBA 代碼阻止外發電子郵件到特定地址

下面的 VBA 代碼可以幫你一個忙,請這樣做:

1. 啟動 Outlook,然後按住 ALT + F11 鍵打開 Microsoft Visual Basic for Applications 窗口。

2。 然後,雙擊 本次展望會議 來自 項目-項目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 = "yy@addin99.com" 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. 發送電子郵件後,您可以在 發送的郵件 文件夾中,特定的電子郵件地址已從收件人中排除,請參見截圖:


Kutools for Outlook-為Outlook帶來100個高級功能,並使工作更加輕鬆!

  • 自動CC / BCC 根據規則發送電子郵件; 自動前進 自定義多封電子郵件; 自動回复 沒有交換服務器,還有更多自動功能...
  • BCC警告 -當您嘗試全部答复時顯示消息 如果您的郵件地址在“密件抄送”列表中; 缺少附件時提醒,還有更多提醒功能...
  • 在郵件對話中回复(全部)帶有所有附件; 回复許多電子郵件 片刻之間; 自動添加問候語 回复時將日期添加到主題中...
  • 附件工具:管理所有郵件中的所有附件, 自動分離, 全部壓縮,重命名全部,保存全部...快速報告, 計算選定的郵件...
  • 強大的垃圾郵件 習俗 刪除重複的郵件和聯繫人... 使您能夠在Outlook中做得更聰明,更快和更好。
拍攝kutools前景kutools選項卡1180x121
拍攝kutools前景kutools加標籤1180x121
 
按評論排序
留言 (0)
還沒有評分。 成為第一位評論!
這裡還沒有評論
留下你的意見
以訪客身份發帖
×
評價此帖子:
0   字符
推薦地點