Как да проверя адресите на получателите преди изпращане през Outlook?

Автор: Слънце Последна промяна: 2020-09-18

Понякога може да пропуснете да добавите някои важни получатели в полетата До, CC или BCC, докато изпращате имейли през Outlook. Тук мога да представя метод за проверка дали конкретните имейл адреси са добавени преди изпращане през Outlook.

Проверете адресите преди изпращане с VBA код

Проверете адресите преди изпращане с VBA код

Тук имам два кода, които могат да ви помогнат да решите тази задача, можете да изберете всеки, който ви е необходим.

1. Натиснете Alt + F11 kбутони за активиране Microsoft Visual Basic за приложения прозорец.

2. Кликнете два пъти ThisOutlookSession от 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

doc проверете адреса на получателя преди изпращане 1

В кода можете да промените ("""""") до истинските получатели, от които се нуждаете.

3. След това също в Microsoft Visual Basic за приложения прозорец, кликнете Инструменти > Препратки. Проверка Microsoft Scripting Runtime квадратче за отметка в Референции-Проект1 диалогов прозорец.

doc проверете адреса на получателя преди изпращане 2

doc проверете адреса на получателя преди изпращане 3

4. кликване OK и запазете кода.

Сега, ако посочените получатели не се показват в полето До, докато изпращате имейли, ще се появи диалогов прозорец, за да ви напомни дали да изпратите имейла.
doc проверете адреса на получателя преди изпращане 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 Scripting Runtime отметка, просто директно запазете кода, за да влезе в сила.