A standard method is to check addresses while in ItemSend. One solution could look like this.
Private Sub Application_ItemSend_test()
Dim currItem As mailItem
Set currItem = CreateItem(0)
currItem.Subject = "test"
currItem.To = "dummy1ATsomewhere.com; allowableATsomewhere.com"
currItem.Recipients.ResolveAll
currItem.Display
Application_ItemSend currItem, False
End Sub
Private Sub Application_ItemSend(ByVal Item As mailItem, Cancel As Boolean)
' Put code in the ThisOutlookSession module
' Checks the recipients on an outgoing email
Dim strAddress As String
Dim strSearchNamesFound As String
Dim objRecipient As Recipient
Dim longFound As Long
Dim longButtons As Long
Dim i As Long
' Array to hold addresses of forbidden recipients
Dim strSearchArray() As String
Dim arraySize As Long
' Only two names in this example
arraySize = 2
ReDim strSearchArray(arraySize)
strSearchArray(1) = "dummy1ATsomewhere.com"
strSearchArray(2) = "dummy2ATsomewhere.com"
For Each objRecipient In Item.Recipients
strAddress = objRecipient.Address
' ***************************************
' To see the address as Outlook sees it.
' Replace the dummy text in the array of addresses.
Debug.Print "Address: " & strAddress
' ***************************************
For i = 1 To arraySize ' The number of entries in strSearchArray
longFound = InStr(1, strAddress, strSearchArray(i), vbTextCompare)
If longFound > 0 Then
strSearchNamesFound = strSearchNamesFound & strSearchArray(i) & vbCr & vbCr
End If
Next i
Next objRecipient
If strSearchNamesFound <> "" Then
Cancel = True
longButtons = vbOKOnly + vbSystemModal + vbMsgBoxSetForeground
strSearchNamesFound = "Forbidden recipient(s) found. Send is cancelled." & _
vbCr & vbCr & strSearchNamesFound
MsgBox strSearchNamesFound, longButtons
Debug.Print strSearchNamesFound
End If
ExitRoutine:
Set objRecipient = Nothing
End Sub