CODEWITHSUNDEEP
vbaoutlook
Steven
Steven

Reputation: 5

Prompt for verifying recipients

When sending an email to anyone outside of my business I want a prompt asking for confirmation with all the recipients printed in the prompt.

I tried code from Outlook VBA to verify recipient. It does nothing.

I tried multiple things from multiple sites but none give me what I am looking for.

I am using the following code:

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

CheckList = "[email protected]"

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

This code makes use of a checklist. The idea is to fill the checklist with all the e-mails of the company and prompt with an if-statement when the recipient is not in this list (prompting with all mail addresses of the recipients that are not in the checklist).

I also tried this and it will prompt but it prints every item in the 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 = "[email protected]"
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

Upvotes: 0

Views: 406

Answers (1)

Dmitry Streblechenko
Dmitry Streblechenko

Reputation: 66306

Multiple problems - you are treating Recipient object as a string (you pass it to LCase, which expects a string) - in that case VBA converts the object to a string by reading the default property (which is most likely Name). You need to use recip.Address instead.

Are you using Exchange Server? In that case all internal recipients will have address type of "EX" and external recipients "SMTP"

In that case your check must be 

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

Upvotes: 1

Related Questions