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.
 
Thread starter Similar threads Forum Replies Date
Diane Poremsky Warn before sending messages to the wrong email address New Slipstick.com Articles 1
O Create a custom contact form - questions before messing things up... Outlook VBA and Custom Forms 4
L unblocking attachments before sending Office 365 Advanced Protection Using Outlook 0
PGSystemTester VBA To Change AppointmentItem.BusyStatus From MeetingItem Before Send Using Outlook 0
W Outlook 2010 some sent items marked unread now (was Ok before) Using Outlook 0
M Auto expand Distribution List Before Sending Email Outlook VBA and Custom Forms 1
M Moving mail to another folder is much slower than before (Office365) Using Outlook 0
A Check for words in subject header before sending email Outlook VBA and Custom Forms 4
CWM030 Rules disappearing in OL 2016? ( Yes, I searched before posting) Using Outlook 7
U Outlook 2010 'freezes' before moving emails Using Outlook 2
S Mail filter recieved before the last 2 working days Using Outlook 1
copperberry How to display incomplete tasks due on or before 7 days from now Using Outlook 0
O Rules and Alerts for New Messages BEFORE sending Using Outlook 2
G Can't open .pst. Message could not access default folder (Outlook 2010 (.pst). Before that was backi Using Outlook 0
Diane Poremsky Select from a List of Subjects before Sending a Message New Slipstick.com Articles 0
Diane Poremsky Check Contacts before moving them to Hotmail Contacts folder New Slipstick.com Articles 0
Diane Poremsky Check for missing attachments before sending a message New Slipstick.com Articles 1
J How to validate any email address before it is sent Using Outlook 2
K Problem with FreeBusy (before 1pm only) Outlook VBA and Custom Forms 7
Diane Poremsky Add Attachment Names to Message Before Sending New Slipstick.com Articles 0
Diane Poremsky Check Message Size Before Sending New Slipstick.com Articles 0
Diane Poremsky Add Secure to the Message Subject before Sending New Slipstick.com Articles 0
J Creating a URL from a message body excerpt before forwarding Using Outlook 2
F Recurring meeting with recurring prep. 2 days before Using Outlook 1
S Checking attachment is passward protected or not before sending the mail Using Outlook 1
D how to get inbox messages to appear before deleted file messages? Using Outlook 6
D verify contact before sending Using Outlook 7
N Eliminate the +1 before all numbers Using Outlook 1
C Is there a way to prompt a user before deleting an item? BCM (Business Contact Manager) 4
S Outlook to validate task form before sending Using Outlook 5
S Prompt to add for text to existing subject line before sending. Using Outlook 9
N Outlook should use address in address book before the address in Autocomplete Using Outlook 0
S Trying to have a prompt to ask for text to be added to subject before sending. Using Outlook 3
L check if send message appears in SendItems forder before moving Using Outlook 0
H Insert Specific Text before Subject for New mails and reply Using Outlook 3
R What to backup before removing Outlook 2010? Using Outlook 4
T Is there a way to apply a macro before a signature is applied in email? Using Outlook 1
V Before send criteria Using Outlook 5
B How do I get a warning before deleting e-mail messages? Using Outlook 2
E Why does a Mailboximportrequest queue for at least 10 minutes before starting the import? Exchange Server Administration 1
S Edge Transport 3rd party mail filter before Exchange 2010 Exchange Server Administration 5
T Have to type in login to OWA twice before able to login Using Outlook 17
H Outlook 2010 "The end date you entered is before the start date..." Using Outlook 7
I Prompt before sending contacts to Deleted Items folder Using Outlook 7
A Emails are Delayed by several hours before appearing in my inbox Using Outlook 4
R Sending a copy of a link adds garbage before the link Using Outlook 3
F Must connect o Microsoft Exchange before you can use your offline folder file (Error msg) Using Outlook 4
E Can I safely delete multiple PST files before upgrading to Office 2010 from Office 2007? Using Outlook 19
S Removal of Interim Update packages before installing any Exchange Server 2010 service pack Exchange Server Administration 1
T New-MailboxExportRequest queues for over 15 minutes before executing. Also seems limited to 1 mailb Exchange Server Administration 2
Similar threads


















































Top