Warn Before Sending: Checking Contact Categories

A user wanted to know: Is it possible to warn you when you are sending an email to a Contact who is assigned a specific category?

While it's not a feature built into Outlook, you can use an ItemSend macro to check the contacts and if they are in specific categories, pop up a warning.

This macro checks for contacts in one of two categories. Clicking No will cancel the send.

If there are two addresses or more addresses, it will check every recipient and pop up the dialog as needed or until No is clicked.

This macro can check any contact field, although it makes the most sense to check categories.

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
     
  Dim Recipients As Outlook.Recipients
  Dim recip As Outlook.Recipient
  Dim oRecip As Variant
  Dim i
  Dim prompt As String
  Dim oContact As Outlook.ContactItem

On Error Resume Next
 ' use lower case for the address
 ' LCase converts all addresses in the To field to lower case
 
 Set Recipients = Item.Recipients
 For i = Recipients.Count To 1 Step -1
    Set recip = Recipients.Item(i)
 '   Debug.Print i, recip.Address

' look up contact category
' ###############
  Set oContact = Nothing
  Set oContact = GetContact(recip.Address)

If Not oContact Is Nothing Then
Debug.Print oContact
  strCategories = oContact.Categories
Else
GoTo NextI
End If
'#################

 'Debug.Print recip.Address, strCategories
 If InStr(1, LCase(strCategories), "vendor") Or InStr(LCase(strCategories), "customer") Then
      prompt$ = "You sending this to this to:" & vbCrLf & oContact.FullName & " at " & recip.Address & vbCrLf & "In the " & strCategories & " category." & vbCrLf & "Are you sure you want to send it?"
       If MsgBox(prompt$, vbYesNo + vbQuestion + vbMsgBoxSetForeground, "Check Address") = vbNo Then
         Cancel = True
         Exit Sub
       End If
  End If

NextI:
Next i
 
End Sub

Private Function GetContact(Adr As String) As Outlook.ContactItem
 ' http://www.vboffice.net/en/developers/join-email-with-contact-data
  Dim Contact As Outlook.ContactItem
  Set m_Contacts = Application.Session.GetDefaultFolder(olFolderContacts).Items
  
  Set Contact = m_Contacts.Find("[Email1Address]='" & Adr & "'")
  If Contact Is Nothing Then
    Set Contact = m_Contacts.Find("[Email2Address]='" & Adr & "'")
  End If

  If Contact Is Nothing Then
    Set Contact = m_Contacts.Find("[Email3Address]='" & Adr & "'")
  End If

  Set GetContact = Contact

End Function

How to use the macros on this page

First: You need to have macro security set to the lowest setting, Enable all macros during testing. The macros will not work with the top two options that disable all macros or unsigned macros. You could choose the option Notification for all macros, then accept it each time you restart Outlook, however, because it's somewhat hard to sneak macros into Outlook (unlike in Word and Excel), allowing all macros is safe, especially during the testing phase. You can sign the macro when it is finished and change the macro security to notify.

To check your macro security in Outlook 2010 and newer, go to File, Options, Trust Center and open Trust Center Settings, and change the Macro Settings. In Outlook 2007 and older, look at Tools, Macro Security.

After you test the macro and see that it works, you can either leave macro security set to low or sign the macro.

Macros that run when Outlook starts or automatically need to be in ThisOutlookSession, all other macros should be put in a module, but most will also work if placed in ThisOutlookSession. (It's generally recommended to keep only the automatic macros in ThisOutlookSession and use modules for all other macros.) The instructions are below.

The macros on this page need to go into ThisOutlookSession.

Open the VBA Editor by pressing Alt+F11 on your keyboard.

To put the macro code in ThisOutlookSession:

1. Expand Project1 and double click on ThisOutlookSession.
2. Copy then paste the macro into ThisOutlookSession. (Click within the code, Select All using Ctrl+A, Ctrl+C to copy, Ctrl+V to paste.)

More information as well as screenshots are at How to use the VBA Editor