Thursday, April 23, 2015

Outlook warn when forgetting attachment

When an outlook message indicates an attachment is added, but the attachment is missing, the Outlook 2010 VBA macro below can warn you about this with a popup. This option became a standard option in Outlook 2013, as indicated on this site.

This version of the macro has been extended compared to many similar macro’s you could find online:

  • It allows to configure multiple words to scan for, currently scanning for attach, bijlage, bijgevoegd (see inline VBA comments)
  • It will only scan the new message body and the header. It will ignore the reply/forward message body content.
  • It has been improved for html/rich text/plain text emails formatting
  • It allows you to configure if attachments are part of your signature
  • Non-mail outlook item types will not result in VBA errors (eg. when responding a meeting request)

All feedback is welcome, since only tested on a English version of Outlook 2010.

Installation instructions:

  • Open Outlook and press [ALT+F11] to open the VBS developer editor
  • Navigate to 'Project 1 VbaProject.OTM' > Microsoft Outlook Objects > ThisOutlookSession
  • Copy and Paste the macro below and close the VBS editor or import the ‘ThisOutlookSession.cls’ file

Source Office VBA macro script:

'myT 04/2015, http://myTselection.blogspot.com    
'Instructions:
'Open Outlook and press [ALT+F11] to open the VBS developer editor
'Navigate to 'Project 1 VbaProject.OTM' > Microsoft Outlook Objects > ThisOutlookSession
'Copy and Paste the macro below and close the VBS editor
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim m As Variant, t As Variant
Dim strBody As String
Dim intIn As Long
Dim intAttachCount As Integer, intStandardAttachCount As Integer, limitBody As Integer
On Error GoTo handleError
'Edit the following line if you have a signature on your email that includes images or other files. Make intStandardAttachCount equal the number of files in your signature.
intStandardAttachCount = 0
'If CheckProperty(Item, "HTMLBody") Then
'    strBody = LCase(Item.HTMLBody) & " " & LCase(Item.Subject)
'Else
'    strBody = LCase(Item.Body) & " " & LCase(Item.Subject)
'End If
On Error GoTo NoHtml
strBody = LCase(Item.HTMLBody) & " " & LCase(Item.Subject)
'Show Debug via View > Immediate Window (Ctrl+G)
'Debug.Print strBody
On Error GoTo handleError
'detect line break where previous messages (reply/forward) are starting, only scan the newly create message ignoring forwarded/replied text
'HTML original message splitter
limitBody = InStr(1, strBody, "<div style='border:none;border-top:solid #b5c4df 1.0pt;padding:3.0pt 0cm 0cm 0cm'>")
'RichText has HTMLBody but no border separator
If limitBody = 0 Then GoTo RichText
GoTo commonHandling
RichText:
    On Error GoTo handleError
    'could test on availability of 'text/rtf format' in body to make sure this is rich text case
    strBody = LCase(Item.Body) & " " & LCase(Item.Subject)
    'rich text original message splitter
    limitBody = InStr(1, strBody, "_____________________________________________")
GoTo commonHandling
NoHtml:
    On Error GoTo handleError
    strBody = LCase(Item.Body) & " " & LCase(Item.Subject)
    'detect line break where previous messages (reply/forward) are starting, only scan the newly create message ignoring forwarded/replied text
    'Plain text message splitter
    limitBody = InStr(1, strBody, "-----")
GoTo commonHandling
commonHandling:
    On Error GoTo handleError
    'Show Debug via View > Immediate Window (Ctrl+G)
    'Debug.Print strBody
   
    If limitBody = 0 Then limitBody = Len(strBody)
   
   
    intIn = InStr(1, Left(strBody, limitBody), "attach")
    intIn = intIn + InStr(1, Left(strBody, limitBody), "bijlage")
    intIn = intIn + InStr(1, Left(strBody, limitBody), "bijgevoegd")
    'Copy previous line to add extra keywords
   
    intAttachCount = Item.Attachments.Count
   
    If (intIn <> 0 And intAttachCount = intStandardAttachCount) Then
       
        m = MsgBox("It appears that you mean to send an attachment, " & vbCrLf & "but there is no attachment to this message." & vbCrLf & vbCrLf & "Do you still want to send without attachments?", vbQuestion + vbYesNo + vbMsgBoxSetForeground, "Missing attachment")
   
        If m = vbNo Then
            Cancel = True
        End If
    End If
handleError:
    If (Err.Number <> 0) Then
        t = MsgBox("Outlook Attachment Reminder Error " & Err.Description & ", " & Err.Number & ", " & Err.Source, vbExclamation, "Outlook Attachment Reminder Error")
    End If
End Sub


Download the macro and instructions in a TXT file.