Outlook VBA запрос на проверку получателей

Question

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

Я пытался использовать код здесь: Outlook VBA для проверки получателя

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

Я использую следующий код в Outlook VBA:

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim lbadFound  As Boolean
Dim badAddresses As String
lbadFound = False

CheckList = "test@test.nl"

    Set Recipients = Item.Recipients
    For i = Recipients.Count To 1 Step -1
      Set recip = Recipients.Item(i)

      If InStr(1, LCase(CheckList), LCase(recip)) >= 1 Then
          lbadFound = True
          badAddresses = badAddresses & recip & vbCrLf
      End If

    Next i

    If lbadFound Then
       prompt$ = "You sending this mail to one or more black listed email address(es)" & badAddresses & vbCrLf & " Are you sure you want to send it?"
       If MsgBox(prompt$, vbYesNo + vbQuestion + vbMsgBoxSetForeground, "Check Address") = vbNo Then
         Cancel = True
       End If
    End If
End Sub

Этот код использует контрольный список. Идея состоит в том, чтобы заполнить контрольный список всеми электронными письмами компании и запросить оператор if, если получателя нет в этом списке (запросить все адреса электронной почты включенных получателей, которых нет в контрольном списке).

Я также попробовал это, и он подскажет, но он печатает каждый в xAddress:

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

Заранее спасибо!

Answer 1

Многочисленные проблемы - вы обрабатываете Recipient объект как строку (вы передаете его LCase, который ожидает строку) - в этом случае VBA преобразует объект в строку, читая свойство по умолчанию (которое наиболеескорее всего Name). Вам нужно использовать recip.Address.

Используете ли вы Exchange Server? В этом случае все внутренние получатели будут иметь тип адреса «EX», а внешние получатели «SMTP»

. В этом случае ваш чек должен быть

If recip.AddressEntry.Type = "SMTP" Then
   ...