2019-01-13

Accidentally Sending Emails to the Wrong Person?

Everyone has sent a message to the wrong person at least once.  Maybe it's an text message and you accidentally respond to the wrong conversation, or added the wrong name to an email.  Quite often it isn't a huge deal because of the fact we've all done it.  You'll receive a message that makes absolutely no sense, maybe responding with a "?", or you get a follow up soon after telling you to please ignore it.

Sending increasing personal information is embarrassing, and in business sending private or confidential information can be a huge problem.

In Outlook, it's quite easy to add a macro that double checks the recipients before an email is sent, comparing the domain name (ex. gmail.com, companyy.com, etc.).  Typically when I send emails to multiple recipients they have the same domain name, ignoring the domain of the company I work for.  

So here's what I use to make sure I don't accidentally CC the wrong person.  I added the VBA code at the bottom of the post to Outlook, and I get a verification popup every time I send an email to multiple domains that aren't in my ignoreDomains and ignoreStartsWith lists.

Another thing that can be done, which I do as well because quite often I think of extra things to add to an email right after sending it, is to add a rule to delay sends by X minutes.

Useful Links:



Option Explicit

Private Function ignoreDomains() As Variant
    ignoreDomains = Array("example.com", "example2.com")
End Function

Private Function ignoreStartsWith() As Variant
    ignoreStartsWith = Array("jay@trustworthy.com", "bob@trust.com")
End Function

Private Sub Application_ItemSend(ByVal objItem As Object, cancel As Boolean)
    Dim email As mailItem
    Dim warn As Boolean
    Dim message As String

    If ("MailItem" = TypeName(objItem)) Then
        Set email = objItem
        warn = domainMismatch(email, message)
        cancel = verifyCancelSend(warn, "This email is addressed to multiple domains." & vbCrLf & vbCrLf & message)
    End If
End Sub

Private Function verifyCancelSend(ByRef warn As Boolean, msg As String) As Boolean
    Dim retVal As Boolean
   
    If (warn) Then
        Beep
        retVal = (MsgBox(msg & vbCrLf & vbCrLf & "Would you like to cancel sending the email?", vbYesNo, "Cancel Send Confirmation") <> vbNo)
    End If
   
    verifyCancelSend = retVal
End Function

Private Function domainMismatch(mi As mailItem, message As String) As Boolean
    Dim retVal As Boolean
    Dim rc As Recipient
    Dim domain As String
    Dim baseDomain As String
    Dim ignoreStartValue As Variant
    Dim ignoreDomainValue As Variant
    Dim ignoreStart As Boolean
    Dim ignoreDomain As Boolean
   
    message = ""
    baseDomain = ""
    retVal = False

    For Each rc In mi.Recipients
        ignoreStart = False
        For Each ignoreStartValue In ignoreStartsWith()
            If (LCase(ignoreStartValue) = LCase(Left(rc.Address, Len(ignoreStartValue)))) Then
                ignoreStart = True
            End If
        Next
       
        If (Not ignoreStart) Then
            ignoreDomain = False
           
            domain = LCase(Right(rc.Address, Len(rc.Address) - InStr(rc.Address, "@")))
           
            For Each ignoreDomainValue In ignoreDomains()
                If (ignoreDomainValue = domain) Then
                    ignoreDomain = True
                End If
            Next
           
            If (Not ignoreDomain) Then
                If "" = baseDomain Then
                    message = rc.Address
                    baseDomain = domain
                End If
               
                If (baseDomain <> domain) Then
                    retVal = True
                    message = message & vbCrLf & rc.Address
                End If
            End If
        End If
    Next

    domainMismatch = retVal
End Function