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
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:
- Add VBA code to outlook
- How to run a macro when an email is sent
- Delay sending all emails by X minutes
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
