Jak zkontrolovat adresy příjemců před odesláním prostřednictvím aplikace Outlook?

Autor: Sun Naposledy změněno: 2020-09-18

V některých případech vám může chybět přidání některých důležitých příjemců do polí To, CC nebo BCC při odesílání e-mailů prostřednictvím aplikace Outlook. Zde můžu představit metodu pro kontrolu, zda byly přidány konkrétní e-mailové adresy před odesláním prostřednictvím aplikace Outlook.

Před odesláním zkontrolujte adresy pomocí kódu VBA

Před odesláním zkontrolujte adresy pomocí kódu VBA

Zde mám dva kódy, které vám pomohou vyřešit tuto práci, můžete si vybrat kohokoli, jak potřebujete.

1. lis Alt + F11 kvšechny povolit Microsoft Visual Basic pro aplikace okno.

2. Dvojklik ThisOutlookSession od Project1 v podokně otevřete editor kódu, zkopírujte a vložte pod kód do editoru.

VBA: před odesláním zkontrolujte adresu příjemce v poli Komu

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

před odesláním zkontrolujte adresu příjemce

V kódu můžete změnit ("""""") skutečným příjemcům, které potřebujete.

3. Pak také v Microsoft Visual Basic pro aplikace okno, klepněte na tlačítko Tools > Reference. Check Microsoft Scripting Runtime zaškrtávací políčko Reference-Project1 dialog.

před odesláním zkontrolujte adresu příjemce

4. cvaknutí OK a uložte kód.

Nyní Pokud se zadaní příjemci nezobrazí v poli Komu při odesílání e-mailů, zobrazí se dialogové okno s připomenutím, zda má být e-mail odeslán.
před odesláním zkontrolujte adresu příjemce

U výše uvedeného kódu kontroluje pouze e-mailové adresy Na pole, pokud se chcete přihlásit Na, CC a BCC pole, můžete použít níže uvedený kód.

VBA: před odesláním zkontrolujte adresu příjemce v polích 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

S tímto kódem nemusíte kontrolovat Microsoft Scripting Runtime zaškrtávací políčko, stačí kód přímo uložit, aby se projevil.