如何在透過 Outlook 寄送郵件前檢查收件人地址？

有時透過 Outlook 寄送電子郵件時，您可能會遺漏將某些重要收件人加入「收件者」、「副本」或「密件副本」欄位。以下將介紹一種方法，讓您在寄件前檢查特定郵箱地址是否已包含其中。

使用 VBA 程式碼在寄送前檢查地址

---

使用 VBA 程式碼在寄送前檢查地址

這裡提供兩段程式碼，助您輕鬆完成此任務，歡迎依需求任選其一使用。

1. 按下 Alt + F11 鍵，即可開啟 Microsoft Visual Basic for Applications 視窗。

2. 在 Project 1 窗格中雙擊 ThisOutlookSession，即可開啟程式碼編輯器，並將下方程式碼複製貼上至其中！

VBA：在寄送前檢查「收件者」欄位中的收件人地址

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
'UpdatebyExtendoffice20180523
Dim xAddressArr() As Variant
Dim xAddress As String
Dim xRecipient As Recipient
Dim xPrompt As String
Dim xYesNo As Integer
Dim xDictionary As Scripting.Dictionary
On Error Resume Next
Set xDictionary = New Scripting.Dictionary
xAddressArr = Array("example1@126.com", "example2@126.com", "example3@126.com")
For i = LBound(xAddressArr) To UBound(xAddressArr)
    xDictionary.Add xAddressArr(i), True
Next i
For Each xRecipient In Item.Recipients
    If xRecipient.Type = olTo Then
        If xDictionary.Exists(xRecipient.Address) Then xDictionary.Remove xRecipient.Address
    End If
Next
If xDictionary.Count = 0 Then GoTo L1
For i = 0 To xDictionary.Count - 1
    If xAddress = "" Then
        xAddress = xDictionary.Keys(i)
    Else
        xAddress = xAddress + "; " & xDictionary.Keys(i)
    End If
Next i
xPrompt = "You are not sending this to: " & xAddress & ". Are you sure you want to send the Mail?"
xYesNo = MsgBox(xPrompt, vbQuestion + vbYesNo, "Kutools for Outlook")
If xYesNo = vbNo Then Cancel = True
L1:
  Set xRecipient = Nothing
  Set xDictionary = Nothing
End Sub

在程式碼中，您可以將「example 1@126.com」、「example 2@126.com」和「example 3@126.com」替換為您所需的實際收件人。

3. 接著，同樣在 Microsoft Visual Basic for Applications 視窗中，點選工具＞ 參考項目。在 References-Project 1 對話方塊中，勾選 Microsoft Scripting Runtime 核取方塊。

4. 按一下確定，立即儲存程式碼！

現在，當您在寄送電子郵件時，若指定的收件人未出現在「收件者」欄位中，系統會彈出對話方塊，提醒您是否仍要繼續寄送郵件。

上述程式碼僅會檢查收件者欄位中的郵箱地址。若您希望同時檢查收件者、副本與密件副本欄位，請立即使用下方程式碼，輕鬆提升郵件驗證效率！

VBA：在寄送前檢查「收件者」/「副本」/「密件副本」欄位中的收件人地址

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
'UpdatebyExtendoffice20180523
Dim xRecipients As Outlook.Recipients
Dim xRecipient As Outlook.Recipient
Dim xPos As Integer
Dim xYesNo As Integer
Dim xPrompt As String
Dim xAddress As String
On Error Resume Next
If Item.Class <> olMail Then Exit Sub
Set xRecipients = Item.Recipients
xAddress = "example1@gmail.com"
For Each xRecipient In xRecipients
    xPos = InStr(LCase(xRecipient.Address), xAddress)
    If xPos = 0 Then
        xPrompt = "You sending this to " & xAddress & ". Are you sure you want to send it?"
        xYesNo = MsgBox(xPrompt, vbYesNo + vbQuestion + 4096, "Kutools for Outlook")
        If xYesNo = vbNo Then Cancel = True
    End If
Next xRecipient
End Sub

使用此程式碼時，無需勾選 Microsoft Scripting Runtime 核取方塊，直接儲存即可立即生效！