Email recipient name verification [closed] - vba

Question

Closed. This question does not meet Stack Overflow guidelines. It is not currently accepting answers.
We don’t allow questions seeking recommendations for books, tools, software libraries, and more. You can edit the question so it can be answered with facts and citations.
Closed 10 months ago.
This post was edited and submitted for review 10 months ago and failed to reopen the post:
Original close reason(s) were not resolved
Improve this question
There is a tool in outlook that notifies a sender about possible missing attachments as they click the send button. This tool seems to search the body of the email for keywords like "attachment" and then check to see if anything is attached to the email. If not, the notification then pops up.
I'm looking for something similar but a bit more advanced. I would like a similar notification pop-up to appear when the body of my email does not contain neither the first name nor the last name of my recipient(s).
EDIT / UPDATE
I have eventually created my own VBA code to solve this problem, based on FaneDuru's answer. Please consider unclosing this question.
Note: my code searches for either the first, middle(s) or last name of each one of the recipients, but only on the first two lines of the body of the email.
If any one of these searches is successful (i.e. if the name is found on the first 2 lines), then the check is successful and the email can be sent, otherwise the sender is notified.
When the recipient's email address is not in the address book of the sender, the programme does other similar things that can be easily seen in the code.
Please feel free to suggest improvements.
Option Explicit
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
If TypeName(Item) = "MailItem" Then
Dim myMail As MailItem, recip As Recipient, strNoRef As String, msg As VbMsgBoxResult, msge As VbMsgBoxResult, noEntry As String
Dim i As Integer
Dim j As Integer
Dim Lines() As String
Dim fLines As String
i = 0
j = 0
Set myMail = Item
Lines = Split(myMail.Body, vbCrLf, 4)
fLines = Lines(0) & Lines(1) & Lines(2)
For Each recip In myMail.Recipients
If recip.Address <> recip.AddressEntry Then
i = i + 1
If Not NameExists(recip.AddressEntry, fLines) Then
j = j + 1
strNoRef = strNoRef & recip.AddressEntry & vbCrLf
End If
End If
Next
For Each recip In myMail.Recipients
If Not recip.Address <> recip.AddressEntry Then
noEntry = noEntry & recip.AddressEntry & vbCrLf
End If
Next
If j = i And noEntry = "" Then
msg = MsgBox("This mail does not contain a reference to anyone of the following:" & vbCrLf & _
vbCrLf & strNoRef & vbCrLf & _
"To send the mail anyway, please press ""Yes"".", vbYesNo, "Send the mail?")
If msg <> vbYes Then Cancel = True
End If
If j = i And noEntry <> "" Then
msg = MsgBox("This mail does not contain a reference to anyone of the following:" & vbCrLf & _
vbCrLf & strNoRef & vbCrLf & _
"And the following recipients are not in the address book:" & vbCrLf & _
vbCrLf & noEntry & vbCrLf & _
"To send the mail anyway, please press ""Yes"".", vbYesNo, "Send the mail?")
If msg <> vbYes Then Cancel = True
End If
If noEntry <> "" And j < i Then
msge = MsgBox("The following recipients are not in the address book:" & vbCrLf & _
vbCrLf & noEntry & vbCrLf & "So, the email was not sent." & vbCrLf & _
"To send it, please press ""Yes"".", vbYesNo, "Send the mail?")
If msge <> vbYes Then Cancel = True
End If
If noEntry = "" And j < i Then
Cancel = False
End If
End If
End Sub
Function NameExists(strName As String, strBody As String) As Boolean
Dim arrName, El
arrName = Split(strName, " ")
For Each El In arrName
If InStr(1, strBody, El, vbBinaryCompare) > 0 Then
NameExists = True: Exit Function
End If
Next El
End Function

Answer 1

In order to achieve what you try explaining, please proceed in the next way:
Change Outlook security settings to make it open with Macro Enabled:
File - Options - Trust Center - Trust Center Settings... - Macro Settings and choose Notifications for all Macros, or Enable All Macros (not recommended.... Press 'OK', of course...
Close and reopen Outlook, choosing Enable Macros!
Press F11 in order to access VBE (Visual Basic for Applications) window. In its left pane you will see Project1 (VBAProject.OTM).
Expand Microsoft Outlook Objects and double click on ThisOutlookSession.
In the opening window (to the right side), please copy the next code:
Option Explicit
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
If TypeName(Item) = "MailItem" Then
Dim myMail As MailItem, recip As Recipient, strNoRef As String, msg As VbMsgBoxResult, noEntry As String
Set myMail = Item 'just to benefit of intellisense suggestions...
For Each recip In myMail.Recipients 'iterate between mail recipients
If recip.Address <> recip.AddressEntry Then 'if the address has a name (not only xxx#domain.com):
If Not NameExists(recip.AddressEntry, myMail.Body) Then 'check if one of its names (first or last) exists
strNoRef = strNoRef & recip.AddressEntry & vbCrLf 'if not, build a string to be used in the message
End If
Else
noEntry = noEntry & recip.AddressEntry & vbCrLf
End If
Next
If noEntry <> "" Then
MsgBox "The following recipients are not in the address book:" & vbCrLf & _
vbCrLf & noEntry
End If
If strNoRef <> "" Then
msg = MsgBox("The mail you try sending does not contain a reference to" & vbCrLf & _
vbCrLf & strNoRef & vbCrLf & "and it cannot be sent..." & vbCrLf & _
"To send it as it is, please press ""Yes"".", vbYesNo, "Send the mail?")
If msg <> vbYes Then Cancel = True 'if not pressing "Yes", the sending will be cancelled
End If
End If
End Sub
Function NameExists(strName As String, strBody As String) As Boolean
Dim arrName, El
arrName = Split(strName, " ")
For Each El In arrName
If InStr(1, strBody, El, vbBinaryCompare) > 0 Then
NameExists = True: Exit Function
End If
Next El
End Function
It would be good to press Save on the VBE Standard toolbar. I thing Ctrl + S will also work...
Try playing with mails and send some feedback...