Attachment Reminder - and more for MS Outlook

I just did it again. We don't like to admit it, but we all have. You write a long letter describing the attachment, press send and then 10 seconds later remember you didn't actually attach the message.

I finally decided to do something about it.

Turns out it isn't too hard. Chiefly because Jimmy Peña at Code for Excel and Outlook already did all the hard work of writing up an excellent MS Outlook Etiquette Check Macro that does all the dirty work for you.

What's left for you to do?

1. In MS Outlook go to Tools > Macros > Visual Basic Editor
2. Under the Project Panel (far left) Browse to Project1 > Microsoft Office Outlook Objects > ThisOutlookSession
3. Double-click ThisOutlookSesson to Open (if you haven't been here before this will be a big blank canvas)
4. Visit Code for Excel and Outlook Etiquette Check Code and select "Copy to Clipboard" at the top of the code. Or you can also copy from the code I've modified below if you prefer.
5. Go back to Visual Basic Editor and paste the Code into ThisOutlookSesson
6. Save and Close
UPDATE Apr 24, 2009 3:56PM: Check your macro security settings:
• In Outlook 2000 to 2003, choose Tools | Macro | Security and set security to Medium. In Outlook 2007, the macro security settings are in the Tools | Trust Center dialog. Set macro security to Warn on all macros.
• Restart Outlook.
• When Outlook re-opens you will see a security warning dialog. Choose "Enable Macros"
  
• There is a hack around this we'll leave that for another post

Now just try to be rude. Open a new email message and don't bother with a subject. Press send.


Add "Check out this attachment it'll change your world" to the body and spank send.


Ain't that all kinds of slick? It also will remind you if of missing recipients, blank bodies, signatureless messages, large attachments and too many attachments.

Thanks Jimmy you made my day.

VBA Code

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." & vbCr & _
vbCr & "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, "ENTER PART OF YOUR SIGNATURE HERE") = 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