Outlookを介して送信する前に受信者のアドレスを確認するにはどうすればよいですか？

Outlookを介して電子メールを送信しているときに、重要な受信者を[宛先]、[CC]、または[BCC]フィールドに追加できない場合があります。ここでは、Outlookを介して送信する前に、特定の電子メールアドレスが追加されているかどうかを確認する方法を紹介します。

VBAコードで送信する前にアドレスを確認してください

VBAコードで送信する前にアドレスを確認してください

ここにXNUMXつのコードがあり、この仕事を解決するのに役立ちます。必要に応じて誰でも選択できます。

1。押す Alt + F11 k有効にするための目 アプリケーション向け Microsoft Visual Basic 窓。

2。ダブルクリック このOutlookSession 　 Project1 ペインでコードエディタを開き、以下のコードをコピーしてエディタに貼り付けます。

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("", "", "")
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

送信前に受信者アドレスを確認するドキュメント1

コードでは、変更することができます ("""""") あなたが必要とする本当の受信者に。

3.次に、 アプリケーション向け Microsoft Visual Basic ウィンドウ、クリック ツール > 参考文献。チェック Microsoftスクリプトランタイム のチェックボックス 参考資料-Project1 ダイアログ。

4。クリック OK コードを保存します。

これで、指定した受信者が電子メールの送信中に[宛先]フィールドに表示されない場合、電子メールを送信するかどうかを通知するダイアログがポップアップ表示されます。
送信前に受信者アドレスを確認するドキュメント4

上記のコードでは、のメールアドレスのみをチェックしますにチェックインする場合はフィールドに, CC & BCC フィールドでは、以下のコードを使用できます。

VBA：送信する前にTo / CC / BCCフィールドの受信者アドレスを確認してください

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 = ""
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スクリプトランタイム チェックボックスをオンにすると、コードを直接保存して有効にします。