Как проверить адреса получателей перед отправкой через Outlook?

Author: Sun Last Modified: 2025-08-07

Иногда вы можете забыть добавить важных получателей в поля «Кому», «Копия» или «Скрытая копия» при отправке электронных писем через Outlook. Здесь я могу предложить метод, чтобы проверить, были ли добавлены конкретные адреса электронной почты перед отправкой через Outlook.

Проверка адресов перед отправкой с помощью кода VBA

Проверка адресов перед отправкой с помощью кода VBA

У меня есть два кода, которые могут помочь вам решить эту задачу, и вы можете выбрать любой из них, который вам нужен.

1. Нажмите клавиши Alt + F11, чтобы открыть окно 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("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

doc check recipient address before sending 1

В коде вы можете изменить ("example1@126.com", "example2@126.com", "example3@126.com") на реальных получателей, которые вам нужны.

3. Затем также в окне Microsoft Visual Basic для приложений нажмите Инструменты > Ссылки. Установите флажок Microsoft Scripting Runtime в диалоговом окне Ссылки-Project1.

doc check recipient address before sending 2

doc check recipient address before sending 3

4. Нажмите OK и сохраните код.

Теперь, если указанные получатели не появляются в поле «Кому» при отправке электронных писем, появится диалоговое окно, которое напомнит вам, хотите ли вы отправить письмо.
doc check recipient address before sending 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, просто сохраните код, чтобы он вступил в силу.

AI Mail Assistant в Outlook: Умные ответы, четкое общение (волшебство в один клик!) БЕСПЛАТНО

Оптимизируйте свои ежедневные задачи в Outlook с помощью AI Mail Assistant от Kutools для Outlook. Этот мощный инструмент изучает ваши прошлые письма, чтобы предлагать умные и точные ответы, оптимизировать содержание ваших писем и помогать легко создавать и редактировать сообщения.

Эта функция поддерживает:

Умные ответы: Получайте ответы, созданные на основе ваших предыдущих разговоров — персонализированные, точные и готовые к отправке.
Улучшенное содержание: Автоматически улучшайте текст ваших писем для большей ясности и воздействия.
Простое составление: Просто укажите ключевые слова, и пусть ИИ сделает остальную работу, предлагая несколько стилей написания.
Интеллектуальные расширения: Расширяйте свои мысли с помощью контекстно-зависимых предложений.
Суммаризация: Мгновенно получайте краткие обзоры длинных писем.
Глобальный охват: Легко переводите ваши письма на любой язык.

Эта функция поддерживает: