<

Never Again Forget to Add that Attachment to your Outlook Email

Published on
39,829 Points
26,729 Views
36 Endorsements
Last Modified:
Awarded
Editor's Choice
Community Pick
Issue.  Have you ever sent an email and forgotten to add the attachment?  How embarrassing!!!!  Here's a short Outlook macro to make sure this never happens again.

As I’ve gotten older I’ve noticed that my memory and attention to detail have both gotten worse.  One sign of this is the number of times I’ve sent a message that is supposed to include an attachment only to realize after I clicked "Send" that I forgot to add the attachment.  

If I catch the error, then I quickly send another message with the attachment and a note saying something like, "I guess it’d be handy if I included the attachment."  Sometimes I don’t notice that I forgot the attachment until I get a message from one of the recipients pointing out that I forgot to include it.  It’s not just me either.  I get several messages a month where the sender forgot to include an attachment.  

How do I know that a message should have included an attachment?  Because the message body typically mentions one.  Something like "the attached file", "the attachment", "the enclosed item", etc.  Wouldn’t it be great if Outlook could detect keywords like "attached", "attachment", "enclosed", or "enclosure" in the body of a message and then check to see if there are any attachments?  If there aren’t, then I’d like Outlook to warn me that I may have forgotten to add an attachment.  A feature like this would save me (and perhaps, you) a lot of embarrassment.

Background.  At least through the 2010 version Outlook does not have this ability.

Solution.  Once again Microsoft’s decision to make Outlook extensible via VBA (Visual Basic for Applications) offers us a simple solution.  This is one of the prime reasons I love Outlook.  With a few lines of VBA code you can make Outlook do almost anything you want it to.  In this case it takes about 30 lines of code to add the ability to check a message for keywords and take action based on the results.  

This solution works by trapping Outlook’s ItemSend event.  This event fires each time an item is sent.  The code then searches the body of the message for any of the keywords suggesting that the message should include an attachment.  If any of those keywords are found, then the code checks to see if there are any attachments.  If at least one attachment is found, then the message is sent.  However, if the code doesn’t find at least one attachment, then it displays a dialog-box warning you that you may have forgotten to add the attachment.  The dialog-box offers you the chance to cancel the send so you can add the missing attachment.

Requirements.  Outlook 2000 through 2010.  I've included two different versions, one for Outlook versions 2000 - 2003, and another for Outlook 2007 - 2010.  The reason for this is that Outlook 2007 and later includes features that make the code more useful.  

Instructions.

1. Add the Code to Outlook


Outlook 2000 - 2003.
   1.  Start Outlook.
   2.  Click ToolsMacroVisual Basic Editor.
   3.  If not already expanded, expand Microsoft Office Outlook Objects and click on ThisOutlookSession.
   4.  Copy the code below and paste it into the right-hand pane of Outlook's VB Editor window.
   5.  Edit the code as needed.  I included comment lines wherever something needs to or can change.
   6.  Click the diskette icon on the toolbar to save the changes.
   7.  Close the VB Editor.
   8.  Click ToolsMacroSecurity.
   9.  Set the "Security Level" to Medium.
  10. Close Outlook
  11. Start Outlook
  12. Outlook will display a dialog-box warning that ThisOutlookSession contains macros
        and asking if you want to allow them to run.  Click Yes.

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    'On the next line edit the list of keywords as desired.  Be sure to separate each word with a | character.'
    Const KEYWORDS = "attached|attachment|attachments|enclosed|enclosure"
    'On the next line edit the message that will be displayed when the message should include an attachment as desired.'
    Const WARNING_MSG = "Wording in the message suggests that something is attached, but there are no items attached.  Do you want to cancel the send and add an attachment?"
    'On the next line edit the dialog-box title as desired.'
    Const MSG_TITLE = "Attachment Checker"
    Dim objRegEx As Object, colMatches As Object, bolAttachment As Boolean, olkAttachment As Outlook.Attachment
    Set objRegEx = CreateObject("VBscript.RegExp")
    With objRegEx
        .IgnoreCase = True
        .Pattern = KEYWORDS
        .Global = True
    End With
    Set colMatches = objRegEx.Execute(Item.Body)
    If colMatches.count > 0 Then
        For Each olkAttachment In Item.Attachments
            If olkAttachment.Type <> olEmbeddeditem Then
                bolAttachment = True
                Exit For
            End If
        Next
        If Not bolAttachment Then
            If msgbox(WARNING_MSG, vbQuestion + vbYesNo, MSG_TITLE) = vbYes Then
                Cancel = True
            End If
        End If
    End If
    Set olkAttachment = Nothing
    Set colMatches = Nothing
    Set objRegEx = Nothing
End Sub

Open in new window



Outlook 2007 - 2010.
   1.  Start Outlook.
   2.  Click ToolsMacroVisual Basic Editor.
   3.  If not already expanded, expand Microsoft Office Outlook Objects and click on ThisOutlookSession.
   4.  Copy the code below and paste it into the right-hand pane of Outlook's VB Editor window.
   5.  Edit the code as needed.  I included comment lines wherever something needs to or can change.
   6.  Click the diskette icon on the toolbar to save the changes.
   7.  Close the VB Editor.
   8.  Click ToolsTrust Center.
   9.  Click Macro Security.
  10. Set "Macro Security" to Warnings for all macros.
  11. Click OK.
  12. Close Outlook
  13. Start Outlook.  Outlook will display a dialog-box warning that ThisOutlookSession contains macros and asking if you want to allow them to run.  Click Yes.

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    'On the next line edit the list of keywords as desired.  Be sure to separate each word with a | character.'
    Const KEYWORDS = "attached|attachment|attachments|enclosed|enclosure"
    'On the next line edit the message that will be displayed when the message should include an attachment as desired.'
    Const WARNING_MSG = "Wording in the message suggests that something is attached, but there are no items attached.  Do you want to cancel the send and add an attachment?"
    'On the next line edit the dialog-box title as desired.'
    Const MSG_TITLE = "Attachment Checker"
    Dim objRegEx As Object, colMatches As Object, bolAttachment As Boolean, olkAttachment As Outlook.Attachment
    Set objRegEx = CreateObject("VBscript.RegExp")
    With objRegEx
        .IgnoreCase = True
        .Pattern = KEYWORDS
        .Global = True
    End With
    Set colMatches = objRegEx.Execute(Item.Body)
    If colMatches.count > 0 Then
        For Each olkAttachment In Item.Attachments
            If Not IsEmbedded(olkAttachment) Then
                bolAttachment = True
                Exit For
            End If
        Next
        If Not bolAttachment Then
            If msgbox(WARNING_MSG, vbQuestion + vbYesNo, MSG_TITLE) = vbYes Then
                Cancel = True
            End If
        End If
    End If
    Set olkAttachment = Nothing
    Set colMatches = Nothing
    Set objRegEx = Nothing
End Sub

Function IsEmbedded(olkAttachment As Outlook.Attachment) As Boolean
    'Purpose: Determines if an attachment is embedded.'
    'Written: 9/14/2009'
    'Author: BlueDevilFan'
    'Outlook: 2007'
    Dim olkPA As Outlook.PropertyAccessor
    Set olkPA = olkAttachment.PropertyAccessor
    On Error Resume Next
    IsEmbedded = (olkPA.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x3712001E") <> "")
    On Error GoTo 0
    Set olkPA = Nothing
End Function

Open in new window


2. Test the Solution


Create a test message.  The message should include one of the keywords.  Make sure that you don’t add an attachment.  Click Send.  Outlook should display a pop-up message that looks something like this.  If you click Yes, then Outlook will abort the send giving you the opportunity to add the missing attachment.  Clicking No sends the message on its way immediately.
Outlook Attachment Checker Warning Message
Enhancements.  You can expand the list of keywords that suggests the item should include an attachment by editing line #3 of the code.  Right now the code searches for the words "attached", "attachment", "attachments", "enclosed", or "enclosure".  For example, say that you routinely email .zip files with a message like "Your report is in the ZIP file."  Adding the word "ZIP" to the list of keywords would help ensure that you don't send one of these messages without the required file.
36
Comment
Author:David Lee
66 Comments
 
LVL 50

Expert Comment

by:DanRollins
Clever Idea!  Got my Yes vote!
0
 

Expert Comment

by:a_painter
A very helpful and useful little bit of code. Got my Yes vote!
0
 
LVL 93

Expert Comment

by:Patrick Matthews
BDF,

I still use a variant of this that you provided for me almost 4 years ago in http://www.experts-exchange.com/Software/Office_Productivity/Groupware/Outlook/Q_21925928.html :)

I like how you used RegExp instead of the previous approach of making an array of keywords, and searching for each keyword in turn.

My current Item_Send routine incorporates this as well as the blank subject line prevention you also wrote about:

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    
    ' This sub will scan a mail message before it's sent, looking for a list of words that
    ' indicate you mean to include an attachment.  If it finds any of the words, it then
    ' looks to see if the message has an attachment.  If there is no attachment, you get a
    ' warning message, and a chance to prevent sending the message.
    
    ' Also checks for blank subject field
    
    Dim arrWords As Variant, _
        strWord As Variant, _
        intResponse As Integer, _
        lngSigStart As Long, _
        lngWordStart As Long
    
    ' This is the list of words that the sub will look for.  Use words that suggest the message
    ' probably should have an attachment

    arrWords = Array("enclosed", "attach", "attached", "attachment")

    ' This part looks for a line in my signature; the idea is that the sub will ignore "attachment"
    ' words that come after it, as these words most likely come from previous messages in the thread
    ' and do not pertain to the current message
    
    lngSigStart = InStr(1, Item.Body, "Patrick G. Matthews, Project Manager", _
        vbTextCompare)
    If lngSigStart = 0 Then lngSigStart = 1000000

    ' Item is the object about to be sent; see if it is a mail message, task request, or
    ' meeting request

    Select Case Item.Class
        Case olMail
            
            If Item.Sent = False Then
    
                ' Loop through array of words and look for each in turn

                For Each strWord In arrWords

                    ' Look for the word; if found InStr > 0

                    lngWordStart = InStr(1, LCase(Item.Body), strWord)
                    If lngWordStart > 0 And lngWordStart < lngSigStart Then
    
                        ' If the word is found, check for attachments.  If there are none,
                        ' show the warning
    
                        If Item.Attachments.Count = 0 Then
                            intResponse = MsgBox("Did you forget to attach something?  I " & _
                                "found the word '" & strWord & "'" & Chr(10) & "in your " & _
                                "message, but there is no attachment." & Chr(10) & Chr(10) & _
                                "Click Yes to stop the mail and add an attachment.", _
                                vbYesNo + vbExclamation, "Attachment Check")
    
                            ' If user clicks yes, cancel the send
    
                            If intResponse = vbYes Then
                                Cancel = True
                                Exit Sub
                            End If
                        End If
                        Exit For
                    End If
                Next
                
                ' Check for blank subject
                If Trim(Item.Subject) = "" Then
                    intResponse = MsgBox("You did not put in a subject.  Send anyway?", _
                        vbInformation + vbYesNo, "Subject Check")
                    If intResponse <> vbYes Then Cancel = True
                End If
            End If
    End Select
End Sub

Open in new window


I guess the only substantial difference is that I put in that extra check to make sure that the keyword did not appear below a line from my signature; I wanted to prevent false positives when a, earlier, copied message contained the keyword, but the "current" message did not.

Great work, and voted yes above.

Cheers,

Patrick
0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

 
LVL 50

Expert Comment

by:DanRollins
Nice addition.  One might be able to "generic-ize" it by matching the start of a previous email (eg: "From:" or "To:")
0
 
LVL 50

Expert Comment

by:Dave
Another useful article - thx.

Dave
0
 
LVL 76

Author Comment

by:David Lee
Thanks, guys.

Good suggestion, Patrick!  If you don't mind me using your code, then I'll modify the article code so the check is limited to the current message.
0
 
LVL 93

Expert Comment

by:Patrick Matthews
BDF,

Go ahead, please do :)

Patrick
0
 
LVL 24

Expert Comment

by:Mohammed Hamada
That is terrific, However does this code applies to Microsoft Outlook 2010 ?
0
 
LVL 76

Author Comment

by:David Lee
Hi, moh10ly.

I've not loaded Outlook 2010 yet, so I can't say.  From what I know about 2010 I believe it should work, but I can't say that for certain.
0
 

Expert Comment

by:a_painter
It works fine in Outlook 2010.

I have it running here using 2010 Beta.
0
 
LVL 1

Expert Comment

by:Deon-YCG
Have tested this in Outlook 2010 32bit, forget 64bit version too many isses.

Although finding some of the areas indicated are different I was able to reproduce this in Outlook 2010 - and unfortunately it does not work. The mail with the keywords is sent without any popups

I am running the retail version.
0
 
LVL 76

Author Comment

by:David Lee
Hi, Deon-YCG.

Are macros enabled?
0
 
LVL 32

Expert Comment

by:DrDamnit
Does this work in Outlook 2010?
0
 
LVL 76

Author Comment

by:David Lee
It should.  I haven't loaded 2010 yet so I haven't tested this with that version.
0
 
LVL 1

Expert Comment

by:Deon-YCG
Hi Bluedevil

Yes I have enables macros

I have never done any macro or vb work. In VB I don't get the numers along the side like you have in your code.
0
 
LVL 76

Author Comment

by:David Lee
The numbers are added by EE's web site.  They never appear in the VB editor.  Do any macros work for you in Outlook?
0
 
LVL 1

Expert Comment

by:Deon-YCG
I have never run any macros in Outlook
0
 
LVL 76

Author Comment

by:David Lee
We need to determine if macros aren't working at all or if it's just this macro that's not working.  Add the code below and then try running it.  Let me know what happens.
Sub Testing()
    MsgBox "Macros are working."
End Sub

Open in new window

0
 
LVL 1

Expert Comment

by:Deon-YCG
I have added this above and below the original code and on it's own with no mssg popup
0
 
LVL 76

Author Comment

by:David Lee
How did you run the test and what happened other than the message didn't pop up?  Were there any error/warning messages?
0
 
LVL 1

Expert Comment

by:Deon-YCG
I added it to the top of the original code here. Tested - nothing
Then added to the bottom. tested - nothing
Then added it on top and at the end and recieved error: Compile error. Ambiguous name detected: Testing.

I know this might be frustrasting for you with me with no knowledge of using macros. My apologies
0
 
LVL 1

Expert Comment

by:Deon-YCG
When I put just this code in, run sub in the menu I get the popup
0
 
LVL 76

Author Comment

by:David Lee
No problem.  Adding the code doesn't run it.  How did you run the macro?
0
 
LVL 1

Expert Comment

by:Deon-YCG
Menus, run, run sub/user form  in the VB page
0
 
LVL 76

Author Comment

by:David Lee
Good.  That proves that macros are working.  It's apparently just the article macro that's not working.  I need to get 2010 loaded so I can test this and see what's happening.  I'll do that as soon as I can and get back to you.
0
 
LVL 1

Expert Comment

by:Deon-YCG
Cool. thanks for you patience and assistance
0
 

Expert Comment

by:it-chic
The script works great with the one exception that the MsgBox does not appear on top of message in my Outlook 2003 (works fine in 2007 version).  How can VB script or Outlook options be changed to force MSG on top of Word editor, rather than behind it?  It looks like system is locked up when I send test message until I realized the Error Dialog box was just shown behind current outlook email edit window.
0
 
LVL 76

Author Comment

by:David Lee
I don't have access to a box with Outlook 2003 on it at the moment.  Try changing line #24 to

        If msgbox(WARNING_MSG, vbQuestion + vbYesNo + vbApplicationModal, MSG_TITLE) = vbYes Then

0
 
LVL 1

Expert Comment

by:Deon-YCG
Hi Bluedevil

Have you had any luck with this in Outlook 2010?

Thanks
0
 
LVL 76

Author Comment

by:David Lee
Hi, Deon-YCG.

I haven't had a chance to test it on 2010 yet, but it should work.  Are you saying that you have tried it on 2010 and it doesn't work?
0
 
LVL 1

Expert Comment

by:Deon-YCG
Hi

Yes I am running Outlook 2010 and still unable to get it to run. Maybe 1 day I'll be lucky
0
 
LVL 76

Author Comment

by:David Lee
Are macros enabled?
0
 
LVL 1

Expert Comment

by:Deon-YCG
Hi

Yes, if you look in this thread you will see where we tested macros previously
0
 
LVL 76

Author Comment

by:David Lee
Sorry, didn't notice that this was the continuation of a previous conversation.
0
 

Expert Comment

by:it-chic
BlueDevilFan:

To get MsgBox to front, I had to change line 24 to following:
If MsgBox(WARNING_MSG, vbQuestion + vbYesNo + vbMsgBoxSetForeground, MSG_TITLE) = vbYes Then

Thanks for your help!
0
 
LVL 76

Author Comment

by:David Lee
Cool.  Glad you have a solution.
0
 
LVL 12

Expert Comment

by:Praveen Kumar
Just tested in Outlook 2010, running pefectly.

Thanks
0
 
LVL 76

Author Comment

by:David Lee
Great!  Thanks for sharing that.
0
 

Expert Comment

by:SuraDalbin
Hi BlueDevilFan,

I've been trying to implement this in Office 2007, but for some reason it's not working entirely.  I'm using matthewspatrick code version above, but the only portion that works is the "empty subject line", so I know the code works partially.  The outlook version is running the Outlook 12.0 Object library.

Any thoughts as to what I could do to make this work would be greatly appreciated.

Thanks,


Sura
0
 
LVL 76

Author Comment

by:David Lee
Hi, Sura.

Are you familiar with VBA's debugger?  If so, then set a breakpoint on line 19 of Patrick's code, then send a test message containing one of the triggering keywords.  When the code gets to line 19 it will pause and open the debugger.  You can then step through the code and see what's happening.
0
 

Expert Comment

by:SuraDalbin
Hi BDF,

I apologize about the delayed response. I believe i found the solution to the problem. The code was in fact working correctly, the problem was that my signature includes an image, so if i'm not mistaken, that image counts as an attachment.  I tested the same code without my html signature and it outlook did prompt me to if i wished to send without attachment.

How can we get around this? Because of company policy, i must have that image in my signature.

Thanks for your help.


Sura
0
 
LVL 76

Author Comment

by:David Lee
How about switching from Patrick's code to my code, which tests for embedded images, and I'll show you how to add the blank subject check to it?
0
 

Expert Comment

by:SuraDalbin
Hi BDF,

It's that time of the year for me at the office, so I apologize once again for the delay.  I have switched to your original code, but for some reason it's not prompting me if I've forgotten an attachment, even though I have one or more of the triggering words in my message.  Please help.

Thanks,

Sura
0
 

Expert Comment

by:SuraDalbin
UPDATE:

The code does work if I remove my signature, which contains the company logo.  So, I think the issue, if I may say humbly, is that the code should be able to ignore the image(s) embedded in the body of the e-mail and scan for attachments to the e-mail itself.  I'm just not sure how to say this in vba.

Thanks for your help :-).
0
 
LVL 76

Author Comment

by:David Lee
@SuraDalbin,

I just updated the code.  Download the version for Outlook 2007 - 2010 and replace the version you have now.  Test again and let me know what happens.
0
 
LVL 59

Expert Comment

by:Jim Dettman (Microsoft MVP/ EE MVE)
Wanted to thank you  guys so much for this.  I've merged the ideas from BlueDevilFan and matthewspatrick together.

However rather then searching for a signature, I look for the string "From: " in the body text.  I also used Len(Item.Body) rather then a constant of 1000000.

So far it's working well!

Jim.
0
 
LVL 76

Author Comment

by:David Lee
Good deal.  Thanks for sharing, Jim.
0
 

Expert Comment

by:SuraDalbin
BlueDevilFan,

I must apologize for the extremely dealyed response.  I was having a strange problem in viewing this article, I would see a message that read that the article was pending approval.

Anyway, I wan to thank you for taking the time and addressing this issue.  Yes, the code now works like a charm.  Also, because of ownership changes in our firm, our e-mail signature changed as well, and we now have more than 1 attachment in it, but the code works with this as well.

Thanks a million,


Sura
0
 
LVL 76

Author Comment

by:David Lee
Thanks for the feedback, Sura. Glad you like the solution.
0
 
LVL 20

Expert Comment

by:ltlbearand3
Thanks for this article.  I have been using something similar for several years and just had an issue where it did not work because of the embedded logo in someone else's signature.  Your post helped me fix my code.  I also started using this code before I had a good understanding of RegEx and did not even think of using it.  You use triggered some ideas to make my code better.  

I was using the From and Subject idea search similar to something mentioned above to help look only in my added text (as mentioned is makes it more generic than looking for a particular item in the signature).

The new piece I have added it that I like my message box to show me what word it found as sometimes it can generate a false positive.  Because I sometimes craft an email over a period of time, I may not pay enough attention to what I type early on.  This helps me just do a sanity check.  In the past I just listed the word I found, but with RegEx, I can pretty easily display a little of the surrounding text also.  Here is my code for anyone who wants to add this.

A few other notes:
I handle my message box a little differently to allow me to add that in.
Added a reference in my project instead of using Late Binding.  
Modified the search RegEx to look for variations of the key words - for examples searches for Attach, attached, attaching, anything that starts with attach
You can self sign this marco to help keep macro settings tighter but not have a warning message when outlook opens - http://www.howto-outlook.com/howto/selfcert.htm

Here is the full code:
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    Dim dgrChoice As VBA.VbMsgBoxResult
    Dim olkAttachment As Outlook.Attachment
    Dim objRegEx As VBScript_RegExp_55.RegExp
    Dim colFoundWords As VBScript_RegExp_55.MatchCollection
    Dim objFoundWord As VBScript_RegExp_55.Match
    Dim colWords As VBScript_RegExp_55.MatchCollection
    Dim objFirstWholeWord As VBScript_RegExp_55.Match
    Dim objLastWordSegment As VBScript_RegExp_55.Match
    Dim blnAttachment As Boolean
    Dim strSearchText As String
    Dim strFoundWord As String
    Dim strFoundSection As String
    Dim strMsg As String
    
    Const KEYWORDS As String = "(attach)\w*\s|(enclos)\w*\s|(include)\w*\s"
    
    Set objRegEx = New VBScript_RegExp_55.RegExp
    
    If Item.Class = Outlook.olMail Then
		' Find the Text We want to search.  Only want my addition and not rest of message
		strSearchText = TrimToRecentMessage(Item.Body)
	
		With objRegEx
			.IgnoreCase = True
			.Global = True
			.Pattern = KEYWORDS
			Set colFoundWords = .Execute(strSearchText)
		End With
		
		If colFoundWords.Count > 0 Then
			For Each olkAttachment In Item.Attachments
				If Not IsEmbedded(olkAttachment) Then
					blnAttachment = True
					Exit For
				End If
			Next
		
			If Not blnAttachment Then
				' We did not find an attachment.  Build the message to the user
				strMsg = "It appears you are sending the email without attachments while " & VBA.vbNewLine
				strMsg = strMsg & "the body/subject contains possible references to an attachment." & VBA.vbNewLine
				strMsg = strMsg & VBA.vbNewLine & "Found sections : " & VBA.vbNewLine
				
				For Each objFoundWord In colFoundWords
					' Add in the found word and some surrounding text for the user
					If objFoundWord.FirstIndex > 15 Then
						strFoundSection = Mid(strSearchText, objFoundWord.FirstIndex - 15, objFoundWord.Length + 30)
						
						With objRegEx
							.Pattern = "\b\w+\b"     ' Break into Word segments
							Set colWords = .Execute(strFoundSection)
						End With
						
						If colWords.Count > 0 Then
							Set objFirstWholeWord = colWords.Item(1)
							Set objLastWordSegment = colWords.Item(colWords.Count - 1)
							
							strFoundSection = Mid$(strFoundSection, objFirstWholeWord.FirstIndex + 1, objLastWordSegment.FirstIndex - objFirstWholeWord.FirstIndex - 1)
						End If
					
					Else
						strFoundSection = Left(strSearchText, objFoundWord.Length + 30)
						
						With objRegEx
							.Pattern = "\b\w+\b"     ' Break into Word segments
							Set colWords = .Execute(strFoundSection)
						End With
						
						If colWords.Count > 0 Then
							Set objLastWordSegment = colWords.Item(colWords.Count - 1)
							
							strFoundSection = Left$(strFoundSection, objLastWordSegment.FirstIndex - 1)
						End If
					End If 'objFoundWord.FirstIndex > 15
					
					strMsg = strMsg & "  --" & strFoundSection & VBA.vbNewLine
				Next objFoundWord
			
				
				strMsg = strMsg & VBA.vbNewLine & "Do you want to send the message without attachments?"

				dgrChoice = VBA.MsgBox(strMsg, VBA.vbYesNo + VBA.vbDefaultButton2 + VBA.vbQuestion + VBA.vbSystemModal, _
						   "Possible missing attachment...")

				If dgrChoice = VBA.vbNo Then
				  Cancel = True
				End If
			End If ' Not BlnAttachment
		End If 'colFoundWords.Count > 0
    End If ' Item.Class = Outlook.olMail
    
    Set objRegEx = Nothing

End Sub

Function TrimToRecentMessage(ByVal EmailText As String) As String
    Dim lngMailToPos As Long
  
    lngMailToPos = VBA.InStr(1, EmailText, "From:", VBA.vbTextCompare)
    If lngMailToPos = 0 Then
        lngMailToPos = VBA.InStr(1, EmailText, "Subject:", VBA.vbTextCompare)
        If lngMailToPos = 0 Then
            lngMailToPos = VBA.Len(EmailText)
        End If
    End If
    
    TrimToRecentMessage = Left(EmailText, lngMailToPos)
End Function

Function IsEmbedded(olkAttachment As Outlook.Attachment) As Boolean
    'Purpose: Determines if an attachment is embedded.'
    'Written: 9/14/2009'
    'Author: BlueDevilFan'
    'Outlook: 2007'
    Dim olkPA As Outlook.PropertyAccessor
    Set olkPA = olkAttachment.PropertyAccessor
    On Error Resume Next
    IsEmbedded = (olkPA.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x3712001E") <> "")
    On Error GoTo 0
    Set olkPA = Nothing
End Function

Open in new window


-Bear
0
 
LVL 76

Author Comment

by:David Lee
Hi, Bear.

Thanks.  I'm glad the article proved useful.

I like the idea of displaying the text that triggered the action.  Thanks for sharing this!
0
 
LVL 59

Expert Comment

by:Jim Dettman (Microsoft MVP/ EE MVE)
Hey thanks for sharing that!

Believe it or not, just 10 minutes ago, I sent an e-mail and got the alert, and my first question was "where did I use that?" (it was a false positive).

Then low and behold the alert e-mail pointing to this showed up in my in-box.

Talk about timing!  And I didn't even have to ask a question!

EE get's better and better...LOL.

Jim.
0
 

Expert Comment

by:jeffreywilens
I'm using Outlook 2007 with the Macro.  It works fine but kept getting a false positive due to the word "attachment" in my signature line.  So I just deleted that word.  Then it works fine except when the word attachment is in the email thread from prior messages (it's in the signature line of the person who sent me the first email I am replying to).

I though the version above was modified to prevent this problem.  This is what I am using.  Where is the part that is supposed to confine the search for the word attachments to the new message only?

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    'On the next line edit the list of keywords as desired.  Be sure to separate each word with a | character.'
    Const KEYWORDS = "attached|attachment|attachments|enclosed|enclosure"
    'On the next line edit the message that will be displayed when the message should include an attachment as desired.'
    Const WARNING_MSG = "Wording in the message suggests that something is attached, but there are no items attached.  Do you want to cancel the send and add an attachment?"
    'On the next line edit the dialog-box title as desired.'
    Const MSG_TITLE = "Attachment Checker"
    Dim objRegEx As Object, colMatches As Object, bolAttachment As Boolean, olkAttachment As Outlook.Attachment
    Set objRegEx = CreateObject("VBscript.RegExp")
    With objRegEx
        .IgnoreCase = True
        .Pattern = KEYWORDS
        .Global = True
    End With
    Set colMatches = objRegEx.Execute(Item.Body)
    If colMatches.Count > 0 Then
        For Each olkAttachment In Item.Attachments
            If Not IsEmbedded(olkAttachment) Then
                bolAttachment = True
                Exit For
            End If
        Next
        If Not bolAttachment Then
            If MsgBox(WARNING_MSG, vbQuestion + vbYesNo, MSG_TITLE) = vbYes Then
                Cancel = True
            End If
        End If
    End If
    Set olkAttachment = Nothing
    Set colMatches = Nothing
    Set objRegEx = Nothing
End Sub

Function IsEmbedded(olkAttachment As Outlook.Attachment) As Boolean
    'Purpose: Determines if an attachment is embedded.'
    'Written: 9/14/2009'
    'Author: BlueDevilFan'
    'Outlook: 2007'
    Dim olkPA As Outlook.PropertyAccessor
    Set olkPA = olkAttachment.PropertyAccessor
    On Error Resume Next
    IsEmbedded = (olkPA.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x3712001E") <> "")
    On Error GoTo 0
    Set olkPA = Nothing
End Function
0
 
LVL 76

Author Comment

by:David Lee
Hi, jeffreywilens.

I don't think I ever updated the code to take advantage of @mathewspatrick's suggestion.  Here is a revised version of the original code that does implement that check.  

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    'On the next line edit the list of keywords as desired.  Be sure to separate each word with a | character.'
    Const KEYWORDS = "attach|attached|attachment|attachments|enclose|enclosed|enclosure"
    'On the next line edit the message that will be displayed when the message should include an attachment as desired.'
    Const WARNING_MSG = "Wording in the message suggests that something should be attached, but there are no attachments.  Do you want to send anyway?"
    'On the next line edit the stop string as desired.  The code will search the body up to the point of the stop string.
    Const STOP_STRING = "Regards,"
    'On the next line edit the dialog-box title as desired.'
    Const MSG_TITLE = "Attachment Checker"
    Dim objRegEx As Object, colMatches As Object, bolAttachment As Boolean, olkAttachment As Outlook.Attachment, intStopPos As Integer, strTemp As String
    Set objRegEx = CreateObject("VBscript.RegExp")
    With objRegEx
        .IgnoreCase = True
        .Pattern = KEYWORDS
        .Global = True
    End With
    intStopPos = InStr(1, Item.Body, STOP_STRING)
    If intStopPos > 0 Then
        strTemp = Left(Item.Body, intStopPos - 1)
    Else
        strTemp = Item.Body
    End If
    Set colMatches = objRegEx.Execute(strTemp)
    If colMatches.Count > 0 Then
        For Each olkAttachment In Item.Attachments
            If Not Prod_Support_Functions.IsHiddenAttachment(olkAttachment) Then
                bolAttachment = True
                Exit For
            End If
        Next
        If Not bolAttachment Then
            If MsgBox(WARNING_MSG, vbQuestion + vbYesNo + vbDefaultButton2, MSG_TITLE) = vbNo Then
                Cancel = True
            End If
        End If
    End If
    Set olkAttachment = Nothing
    Set colMatches = Nothing
    Set objRegEx = Nothing
End Sub

Public Function IsHiddenAttachment(olkAtt As Outlook.Attachment) As Boolean
    ' Purpose: Determines if an attachment is a hidden attachment.
    ' Written: 7/12/2012
    ' Author:  David Lee
    ' Outlook: 2007 and later
    Const PR_ATTACH_CONTENT_ID = "http://schemas.microsoft.com/mapi/proptag/0x3712001E"
    Dim olkPA As Outlook.PropertyAccessor, varTemp As Variant
    On Error Resume Next
    Set olkPA = olkAtt.PropertyAccessor
    varTemp = olkPA.GetProperty(PR_ATTACH_CONTENT_ID)
    IsHiddenAttachment = (varTemp <> "")
    On Error GoTo 0
    Set olkPA = Nothing
End Function

Open in new window

0
 
LVL 59

Expert Comment

by:Jim Dettman (Microsoft MVP/ EE MVE)
In regards to:

Const STOP_STRING = "Regards,"

  As I mentioned in my comment above, I found it better to look for the word formatting for "From " in the  e-mail I'm replying to (which I have appear below mine) rather then my signature.

  I often change my signature line, so searching for keywords there often will not work.

  On a new e-mail (not a reply), "From" is not found, so I just search the entire message with Len() of the body.

Jim.
0
 

Expert Comment

by:jeffreywilens
I tried this but got run-time error 424.  I highlighted the bug.

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    'On the next line edit the list of keywords as desired.  Be sure to separate each word with a | character.'
    Const KEYWORDS = "attach|attached|attachment|attachments|enclose|enclosed|enclosure"
    'On the next line edit the message that will be displayed when the message should include an attachment as desired.'
    Const WARNING_MSG = "Wording in the message suggests that something should be attached, but there are no attachments.  Do you want to send anyway?"
    'On the next line edit the stop string as desired.  The code will search the body up to the point of the stop string.
    Const STOP_STRING = "Regards,"
    'On the next line edit the dialog-box title as desired.'
    Const MSG_TITLE = "Attachment Checker"
    Dim objRegEx As Object, colMatches As Object, bolAttachment As Boolean, olkAttachment As Outlook.Attachment, intStopPos As Integer, strTemp As String
    Set objRegEx = CreateObject("VBscript.RegExp")
    With objRegEx
        .IgnoreCase = True
        .Pattern = KEYWORDS
        .Global = True
    End With
    intStopPos = InStr(1, Item.Body, STOP_STRING)
    If intStopPos > 0 Then
        strTemp = Left(Item.Body, intStopPos - 1)
    Else
        strTemp = Item.Body
    End If
    Set colMatches = objRegEx.Execute(strTemp)
    If colMatches.Count > 0 Then
        For Each olkAttachment In Item.Attachments
            If Not Prod_Support_Functions.IsHiddenAttachment(olkAttachment) Then
                bolAttachment = True
                Exit For
            End If
        Next
        If Not bolAttachment Then
            If MsgBox(WARNING_MSG, vbQuestion + vbYesNo + vbDefaultButton2, MSG_TITLE) = vbNo Then
                Cancel = True
            End If
        End If
    End If
    Set olkAttachment = Nothing
    Set colMatches = Nothing
    Set objRegEx = Nothing
End Sub

Public Function IsHiddenAttachment(olkAtt As Outlook.Attachment) As Boolean
    ' Purpose: Determines if an attachment is a hidden attachment.
    ' Written: 7/12/2012
    ' Author:  David Lee
    ' Outlook: 2007 and later
    Const PR_ATTACH_CONTENT_ID = "http://schemas.microsoft.com/mapi/proptag/0x3712001E"
    Dim olkPA As Outlook.PropertyAccessor, varTemp As Variant
    On Error Resume Next
    Set olkPA = olkAtt.PropertyAccessor
    varTemp = olkPA.GetProperty(PR_ATTACH_CONTENT_ID)
    IsHiddenAttachment = (varTemp <> "")
    On Error GoTo 0
    Set olkPA = Nothing
End Function
0
 
LVL 76

Author Comment

by:David Lee
That's my fault.  Change that line to read

If Not IsHiddenAttachment(olkAttachment) Then
0
 

Expert Comment

by:jeffreywilens
Okay thanks, that fixed the bug, but the macro still is giving a false positive.  I tried to send an mail to Jeffrey Spencer (you can't see the headers with my name on it) that has the word "test" in it.  This is a reply to the email immediately below.  The macro gives a false positive that there is an attachment, probably because of the word in Mr. Spencer's signature.


test


Lakeshore Law Center
Jeffrey Wilens, Esq.
18340 Yorba Linda Blvd.
No. 107-610
Yorba Linda, CA 92886
714-854-7205
714-854-7206 (fax)
_____________________________________
This message is sent by a law firm and may contain information that is privileged or confidential. If you received this transmission in error, please notify the
sender by reply e-mail and delete it.
 
For additional information, please visit our website at www.lakeshorelaw.org


From: Jeff Spencer [mailto:jps@spencerlaw.net]
Sent: Friday, February 08, 2013 10:35 AM
To: 'Alejandra Zarate'
Cc: 'Julie Green'; Jeffrey Wilens
Subject: RE: Davis v. Citibank - Mailing Documents for Approval

The documents look fine for mailing.

Jeffrey Spencer
THE SPENCER LAW FIRM
903 Calle Amanecer, Suite 220
San Clemente, CA 92673
(949) 240-8595
(949) 240-8515 (fax)
_______________________

This message is sent by a law firm and may contain information that is privileged or confidential. If you received this transmission in error, please notify the sender by reply  e-mail and delete the message and any attachments.
0
 
LVL 76

Author Comment

by:David Lee
It's not really a false positive.  The disclaimer at the bottom of the message contains the word "attachments".  To avoid having the code scan the entire message you'll need to adjust the stop string on line 7.  Right now it's set to "Regards,".  Changing it to "THE SPENCER LAW FIRM", for example, would prevent the code from scanning beyond that string.  Or if the messages are coming from your mailbox try using "Lakeshore Law Center" or "Jeffrey Willens, Esq.".
0
 

Expert Comment

by:jeffreywilens
I changed

    Const STOP_STRING = "Regards,"

to

    Const STOP_STRING = "From:"

did not get a false positive on the same message.  Will keep testing.
0
 

Expert Comment

by:jeffreywilens
Correct, it was not my disclaimer it was the person to whom I was replying (his disclaimer).  Obviously I cannot predict what will be in the signature line of each person to whom I respond.  So I am using the "From:" hoping that should pick up the beginning of the replied message.
0
 
LVL 76

Author Comment

by:David Lee
"From:" is a good choice so long as you don't have anything in your signature that would trigger a positive.
0
 
LVL 20

Expert Comment

by:ltlbearand3
I wanted to make a note about the changes I posted.  I had someone find a couple bugs in my logic.

You need to change:
Const KEYWORDS As String = "(attach)\w*\s|(enclos)\w*\s|(include)\w*\s"

Open in new window

To
Const KEYWORDS As String = "(attach)\w*|(enclos)\w*|(include)\w*"

Open in new window


And change:
							strFoundSection = Mid$(strFoundSection, objFirstWholeWord.FirstIndex + 1, objLastWordSegment.FirstIndex - objFirstWholeWord.FirstIndex - 1)

Open in new window

To
                                If objFoundWord.Value = objLastWordSegment.Value Then
                                    strFoundSection = Mid$(strFoundSection, objFirstWholeWord.FirstIndex + 1, objLastWordSegment.FirstIndex + objLastWordSegment.Length - objFirstWholeWord.FirstIndex)
                                Else
                                    strFoundSection = Mid$(strFoundSection, objFirstWholeWord.FirstIndex + 1, objLastWordSegment.FirstIndex - objFirstWholeWord.FirstIndex - 1)
                                End If

Open in new window

0
 
LVL 1

Expert Comment

by:Deon-YCG
After all this effort MS comes to the party and adds this in Outlook 2013. Damn, they're slow to catch up.
0
 

Expert Comment

by:KarthikArumugam
Great!!! It is working perfectly in Outlook 2003....
0
 

Expert Comment

by:Suraj *
Thanks, it worked for me. and i have made some keyword changes and applied those we normally use in our workplace
0

Featured Post

Keep up with what's happening at Experts Exchange!

Sign up to receive Decoded, a new monthly digest with product updates, feature release info, continuing education opportunities, and more.

Join & Write a Comment

Is your OST file inaccessible, Need to transfer OST file from one computer to another? Want to convert OST file to PST? If the answer to any of the above question is yes, then look no further. With the help of Stellar OST to PST Converter, you can e…
There may be issues when you are trying to access Outlook or send & receive emails or due to Outlook crash which leads to corrupt or damaged PST file. To eliminate the corruption from your PST file, you need to repair the corrupt Outlook PST file. U…

Keep in touch with Experts Exchange

Tech news and trends delivered to your inbox every month