Recently, I accidentally sent an internal email to a client (fortunately, a forgiving one!).
Since then, I’ve decided to look at ways of avoiding this. It turns out, you can do it with a macro.
I found this one on Slipstick Systems’ website:
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim recips As Outlook.Recipients
Dim recip As Outlook.Recipient
Dim pa As Outlook.PropertyAccessor
Dim prompt As String
Dim strMsg As String
Dim Address As String
Dim lLen
Const PR_SMTP_ADDRESS As String = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"
Set recips = Item.Recipients
For Each recip In recips
Set pa = recip.PropertyAccessor
Address = LCase(pa.GetProperty(PR_SMTP_ADDRESS))
lLen = Len(Address) - InStrRev(Address, "@")
Select Case Right(Address, lLen)
Case "cdolive.com", "slipstick.com", "outlookmvp.com"
Case Else ' remove case else line to be warned when sending to the addresses
strMsg = strMsg & " " & Address & vbNewLine
End Select
Next
If strMsg "" Then
prompt = "This email will be sent outside of the company to:" & vbNewLine & strMsg & vbNewLine & "Please check recipient address." & vbNewLine & vbNewLine & "Do you still wish to send?"
If MsgBox(prompt, vbYesNo + vbExclamation + vbMsgBoxSetForeground, "Check Address") = vbNo Then
Cancel = True
End If
End If
End Sub
Simply list your company’s email domains, and the marco will warn you if you send a message outside of those!
They also provide a tutorial video of how to install the macro.
Advertisements
