Warn before sending message

Post number 5 has been selected as the best answer.

reubendayal

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Exchange Server 2013
Hi Diane,

Hope you are doing well.

I am trying to use your lovely code from slipstick.com's webpage - Warn Before Sending Messages to the Wrong Email Address

Code:
  Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
  Dim Recipients As Outlook.Recipients
  Dim recip As Outlook.Recipient
  Dim i
  Dim prompt As String
  Dim pa As Outlook.PropertyAccessor
    Const PR_SMTP_ADDRESS As String = _
        "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"

On Error Resume Next
' use lower case for the address
' LCase converts all addresses in the To field to lower case

Set Recipients = Response.Recipients
  For i = Recipients.Count To 1 Step -1
    Set recip = Recipients.Response(i)
    Set pa = recip.PropertyAccessor
   
Debug.Print recip.Address
If InStr(LCase(recip.Address), "bad@domain.com") Then
    prompt$ = "You are sending this email to: " & vbCrLf & vbCrLf & _
    Response.To & "." & vbCrLf & vbCrLf & _
    "Are you sure you want to send it?"
    If MsgBox(prompt$, vbYesNo + vbQuestion + vbMsgBoxSetForeground, "Check Address") = vbNo Then
      Cancel = True
      Exit For
    End If
  End If

Next i
End Sub
And need to customize it to display in the prompt the SMTP address of the receivers something that in your above webpage you are referring to under the "Check for different domains". I further need the code to display the SMTP address as some sensible text string for the user as some of the email address are simply too similar to one another and can cause confusion when the user is adding them on to the "To" address field of the email. For example: the email names (without the SMTP address are displayed as Mobility; HR Mobility; HR Internal; HR Support; HRServiceDesk. And this as you can see is quite confusing.

The idea is to have all these email addresses listed in one message box prompt as a list and then if the user clicks okay the email is sent and if the user hits cancel, the email remains unsent (so the user can go in to the email and correct the recipient/s).

And I found another code online but that seems to do the for loop for one email at a time from - How do you extract a recipient's smtp address from an email?

Code:
Sub GetSMTPAddressForRecipients(mail As Outlook.MailItem)
    Dim recips As Outlook.Recipients
    Dim recip As Outlook.Recipient
    Dim pa As Outlook.PropertyAccessor
    Const PR_SMTP_ADDRESS As String = _
        "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"
    Set recips = mail.Recipients
    For Each recip In recips
        Set pa = recip.PropertyAccessor
        Debug.Print recip.name & " SMTP=" _
           & pa.GetProperty(PR_SMTP_ADDRESS)
    Next
End Sub
thank you for helping!

Reuben
 

reubendayal

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Exchange Server 2013
Hi Diane,

Hope you are doing well.

I am trying to use your lovely code from slipstick.com's webpage - Warn Before Sending Messages to the Wrong Email Address

Code:
  Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
  Dim Recipients As Outlook.Recipients
  Dim recip As Outlook.Recipient
  Dim i
  Dim prompt As String
  Dim pa As Outlook.PropertyAccessor
    Const PR_SMTP_ADDRESS As String = _
        "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"

On Error Resume Next
' use lower case for the address
' LCase converts all addresses in the To field to lower case

Set Recipients = Response.Recipients
  For i = Recipients.Count To 1 Step -1
    Set recip = Recipients.Response(i)
    Set pa = recip.PropertyAccessor
  
Debug.Print recip.Address
If InStr(LCase(recip.Address), "bad@domain.com") Then
    prompt$ = "You are sending this email to: " & vbCrLf & vbCrLf & _
    Response.To & "." & vbCrLf & vbCrLf & _
    "Are you sure you want to send it?"
    If MsgBox(prompt$, vbYesNo + vbQuestion + vbMsgBoxSetForeground, "Check Address") = vbNo Then
      Cancel = True
      Exit For
    End If
  End If

Next i
End Sub
And need to customize it to display in the prompt the SMTP address of the receivers something that in your above webpage you are referring to under the "Check for different domains". I further need the code to display the SMTP address as some sensible text string for the user as some of the email address are simply too similar to one another and can cause confusion when the user is adding them on to the "To" address field of the email. For example: the email names (without the SMTP address are displayed as Mobility; HR Mobility; HR Internal; HR Support; HRServiceDesk. And this as you can see is quite confusing.

The idea is to have all these email addresses listed in one message box prompt as a list and then if the user clicks okay the email is sent and if the user hits cancel, the email remains unsent (so the user can go in to the email and correct the recipient/s).

And I found another code online but that seems to do the for loop for one email at a time from - How do you extract a recipient's smtp address from an email?

Code:
Sub GetSMTPAddressForRecipients(mail As Outlook.MailItem)
    Dim recips As Outlook.Recipients
    Dim recip As Outlook.Recipient
    Dim pa As Outlook.PropertyAccessor
    Const PR_SMTP_ADDRESS As String = _
        "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"
    Set recips = mail.Recipients
    For Each recip In recips
        Set pa = recip.PropertyAccessor
        Debug.Print recip.name & " SMTP=" _
           & pa.GetProperty(PR_SMTP_ADDRESS)
    Next
End Sub
thank you for helping!

Reuben

Hi again Diane,

I played around with the code a little more and searched around for similar macros. And have now found the below to be working as required - for most part.

Code:
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim Recipients As Outlook.Recipients
Dim recip As Outlook.Recipient
Dim prompt As String
Dim pa As Outlook.PropertyAccessor
Dim Address As String
Const PR_SMTP_ADDRESS As String = _
    "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"

On Error Resume Next
' use lower case for the address
' LCase converts all addresses in the To field to lower case

Set Recipients = Response.Recipients
For Each recip In Recipients
  
Set pa = recip.PropertyAccessor
Debug.Print recip.Name & " SMTP=" _
       & pa.GetProperty(PR_SMTP_ADDRESS)
If recip.Name = "HR Support" Then
    pa.GetProperty(PR_SMTP_ADDRESS) = "GN HR Support"
End If

Address = recip.Name & " - Email: " & LCase(pa.GetProperty(PR_SMTP_ADDRESS)) & "; " & vbCrLf & vbCrLf & Address

Next

prompt$ = "You are sending this email to: " & vbCrLf & vbCrLf & _
Address & vbCrLf & _
"Are you sure you want to send it?"
If MsgBox(prompt$, vbYesNo + vbQuestion + vbMsgBoxSetForeground, "Check Address") = vbNo Then
  Cancel = True
End If

End Sub
But is it possible to further customize the code for cases where even the email ID is quite confusing to understand and two or more emails from the same domain name could quite easily be mixed up. So to counter such cases, could the macro be customized to state in the displayed prompt another name (hard coded) in this VBA itself? Say for example if the recip.name is HR_Support and the SMTP address is HR_72@domain.com. So if in the message display it could rather state the SMTP address as "HR Support Client Name"?

thanks again.
 

reubendayal

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Exchange Server 2013
Use the recip.Name in the prompt.
Thanks Diane.

If i use the recip.Name in the prompt, then the message box comes out blank... I tried using an if statement with the recip.Name and received an error stating that it is read only and I couldnt use it like that. Any other way to do this?
 

reubendayal

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Exchange Server 2013
Thanks Diane.

If i use the recip.Name in the prompt, then the message box comes out blank... I tried using an if statement with the recip.Name and received an error stating that it is read only and I couldnt use it like that. Any other way to do this?
Hi again Diane,

i tried a little more and then figured if I assigned the value of recip.Name to a string and added the string to the prompt, then the message prompt worked. And then I also custom check each item using an if statement and for the difficult emails this works perfectly now.

thanks again for your help.
 
Top