Etiquette Check
Outlook Etiquette Check VBA Code
I am a big believer in (n)etiquette, that is why I use the ItemSend event of the VBA Outlook.Application object to monitor my outgoing emails for appropriate subject line, number of attachments, etc. Just replace "part of your signature line" in the code with a line from your signature that would only appear if it was in the email. For example, your phone number or full name.
Update 4/27/2009: The code below was updated in response to comments from Brent Thomas.
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
'
' code to manipulate emails after hitting 'Send', but just before they are
' actually sent
'
If TypeName(Item) = "MailItem" Then
' we only want to work on messages, not contacts/notes etc
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim objFolder As Outlook.MAPIFolder
Dim Msg As Outlook.MailItem
Dim sRecip As Outlook.Recipient
Set olApp = Application
Set objNS = olApp.GetNamespace("MAPI")
' set object reference to item passed byval so we can manipulate
Set Msg = Item
' test for missing recipients
If Msg.Recipients.Count = 0 Then
Cancel = True
MsgBox "There are no recipients." & _
"Please select a recipient and re-send your message.", vbCritical
Msg.Display
GoTo ErrorHandle
End If
' test for invalid subject lines & empty body
Select Case Msg.Subject
Case "", "Re:", "RE:", "FW:"
Cancel = True
MsgBox "You are sending a message without a subject." & vbCr & _
vbCr & "Please correct before sending.", vbCritical
Msg.Display
GoTo ErrorHandle
End Select
If Len(Msg.Body) < 2 Then
Cancel = True
MsgBox "You are sending a message without any body text." & vbCr & _
vbCr & "Please correct before sending.", vbCritical
Msg.Display
GoTo ErrorHandle
End If
' check for too many attachments (or too large), it's rude
If Msg.Attachments.Count > 2 Then
If MsgBox("You are sending more than 2 attachments." & _
"Some people might consider this rude. Continue?", _
vbYesNo + vbInformation) = vbNo Then
Cancel = True
Msg.Display
GoTo ErrorHandle
End If
End If
If (Msg.Attachments.Count > 0) And (Msg.Size > 100000) Then
If MsgBox("Your email is pretty big, do you want to stop " & _
"and zip the attachment(s)?", vbYesNo + vbExclamation) _
= vbYes Then
Cancel = True
Msg.Display
GoTo ErrorHandle
End If
End If
' check for missing attachments
If InStr(LCase(Msg.Body), "attach") And (Msg.Attachments.Count = 0) Then
If MsgBox("An attachment was mentioned, but there is no " & _
"attachment to this email. Send anyway?" _
, vbYesNo + vbExclamation + vbDefaultButton1) = vbNo Then
Cancel = True
Msg.Display
GoTo ErrorHandle
End If
End If
' check for missing signature, it's rude, but allow send anyway
If InStr(Msg.Body, "part of your signature line") = 0 Then
If MsgBox("You forgot your signature!" & vbCr & _
"Do you want to add it first?", vbYesNo _
+ vbExclamation) = vbYes Then
Cancel = True
Msg.Display
GoTo ErrorHandle
End If
End If
End If
ErrorHandle:
Set Msg = Nothing
Set objNS = Nothing
Set objFolder = Nothing
Set olApp = Nothing
End Sub
'
' code to manipulate emails after hitting 'Send', but just before they are
' actually sent
'
If TypeName(Item) = "MailItem" Then
' we only want to work on messages, not contacts/notes etc
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim objFolder As Outlook.MAPIFolder
Dim Msg As Outlook.MailItem
Dim sRecip As Outlook.Recipient
Set olApp = Application
Set objNS = olApp.GetNamespace("MAPI")
' set object reference to item passed byval so we can manipulate
Set Msg = Item
' test for missing recipients
If Msg.Recipients.Count = 0 Then
Cancel = True
MsgBox "There are no recipients." & _
"Please select a recipient and re-send your message.", vbCritical
Msg.Display
GoTo ErrorHandle
End If
' test for invalid subject lines & empty body
Select Case Msg.Subject
Case "", "Re:", "RE:", "FW:"
Cancel = True
MsgBox "You are sending a message without a subject." & vbCr & _
vbCr & "Please correct before sending.", vbCritical
Msg.Display
GoTo ErrorHandle
End Select
If Len(Msg.Body) < 2 Then
Cancel = True
MsgBox "You are sending a message without any body text." & vbCr & _
vbCr & "Please correct before sending.", vbCritical
Msg.Display
GoTo ErrorHandle
End If
' check for too many attachments (or too large), it's rude
If Msg.Attachments.Count > 2 Then
If MsgBox("You are sending more than 2 attachments." & _
"Some people might consider this rude. Continue?", _
vbYesNo + vbInformation) = vbNo Then
Cancel = True
Msg.Display
GoTo ErrorHandle
End If
End If
If (Msg.Attachments.Count > 0) And (Msg.Size > 100000) Then
If MsgBox("Your email is pretty big, do you want to stop " & _
"and zip the attachment(s)?", vbYesNo + vbExclamation) _
= vbYes Then
Cancel = True
Msg.Display
GoTo ErrorHandle
End If
End If
' check for missing attachments
If InStr(LCase(Msg.Body), "attach") And (Msg.Attachments.Count = 0) Then
If MsgBox("An attachment was mentioned, but there is no " & _
"attachment to this email. Send anyway?" _
, vbYesNo + vbExclamation + vbDefaultButton1) = vbNo Then
Cancel = True
Msg.Display
GoTo ErrorHandle
End If
End If
' check for missing signature, it's rude, but allow send anyway
If InStr(Msg.Body, "part of your signature line") = 0 Then
If MsgBox("You forgot your signature!" & vbCr & _
"Do you want to add it first?", vbYesNo _
+ vbExclamation) = vbYes Then
Cancel = True
Msg.Display
GoTo ErrorHandle
End If
End If
End If
ErrorHandle:
Set Msg = Nothing
Set objNS = Nothing
Set objFolder = Nothing
Set olApp = Nothing
End Sub
