Scan attachment before send

To answer the second part of the question is that No, Outlook can not detect how many pages in the document.  For the first part, do you want to block the attachment from going out?  This can usually be performed on your mail server, but I Outlook itself can not do this.  Your mail server can also be setup to allow up to specific size of attachment but this would pertain to all attachments and not just Word docs.  

Hi, Alan-Yeo.

If every computer with Outlook also has Word, then I believe I can do this with a little scripting.  Let me know if that's an option.

every computer with outlook does have word...

My company is a recruitment agency and we often have staff mailing CV's to our admin department that are over 3 pages... (company policy to have it 3 or less)

If there was someway to scan the attachment and stop it sending if its over this limit then that would be fantastic!

I remembered a way of checking the page count without having to open Word (which would be slow).  However, this will require you to install a Microsoft DLL on each computer.  The good news is that you can do that through a login script or other automated process.  Once that DLL is installed the code below will do what you described.  It's quick too, a lot faster than if we launched Word in the background.  You can download the component you need here: http://www.microsoft.com/downloads/details.aspx?FamilyId=9BA6FAC6-520B-4A0A-878A-53EC8300C4C2&displaylang=en

Install this on one computer, then copy and register DSOFILE.DLL on each computer needing this script.  Once that's done, add this code to Outlook or, if you already have an Application_ItemSend routine in Outlook, add this code to the existing Application_ItemSend routine.  


Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    Dim olkAttachment As Outlook.Attachment, _
        objFSO As FileSystemObject, _
        objTempFolder As Object, _
        objFilePropReader As Object, _
        objDocProp As Object, _
        strFilename As String
    If Item.Class = olMail Then
        If Item.Attachments.Count > 0 Then
            For Each olkAttachment In Item.Attachments
                If Right(LCase(olkAttachment.FileName), 3) = "doc" Then
                    Set objFSO = CreateObject("Scripting.FileSystemObject")
                    Set objTempFolder = objFSO.GetSpecialFolder(2)
                    strFilename = objTempFolder & "\" & olkAttachment.FileName
                    olkAttachment.SaveAsFile strFilename
                    Set objFilePropReader = CreateObject("DSOleFile.PropertyReader")
                    Set objDocProp = objFilePropReader.GetDocumentProperties(strFilename)
                    If objDocProp.PageCount > 3 Then
                        Cancel = True
                        'Change the message on the following line as desired.
                        MsgBox "The Word attachment has too many pages." & vbCrLf & "This document has " & objDocProp.PageCount & " pages.  The limit is 3."
                    End If
                End If
            Next
        End If
    End If
    Set objDocProp = Nothing
    Set objFilePropReader = Nothing
    Set objTempFolder = Nothing
    Set objFSO = Nothing
End Sub

thanks for getting back to me!!!

Come across an error whilst testing it...

compile Error
User-Defined Type not defined

the debugger highlights
"       objFSO As FileSystemObject, _"

Change FileSystemObject to Object

Run-time error '-2147221005 (800401f3)':
The Operation Failed.

forgot to add...
debugger highlights this line...
                    Set objFilePropReader = CreateObject("DSOleFile.PropertyReader")

Did you download and install component from the link in my post?

I thought it might be that so I installed it again, but doesn't work :(

Heads up for you, I'm running Office 2007, now didn't think this would be a problem, but probably should have mentioned it sooner.

The users who will actually use the code will be using a mixture of 2000 and 2003

I don't know if that component works with 2007.  Can you try on a 2000/2003 system?  I tested this on a 2003 system and it worked flawlessly.

Ok, tried with a 2003 machine...

Still no go, same error.

Just to make sure, you downloaded the component from the Microsoft site, installed it on the system, then ran the code and it failed.  Is that correct?  If so, what's the exact error?

Downloaded and installed from...
http://www.microsoft.com/downloads/details.aspx?FamilyId=9BA6FAC6-520B-4A0A-878A-53EC8300C4C2&displaylang=en

I get error message...
Run-time error '-2147221005 (800401f3)':
The Operation Failed.

Debugger highlights this line...
                    Set objFilePropReader = CreateObject("DSOleFile.PropertyReader")

I have tried it on 2 systems, one is XP with Office 2003, other is Vista with Office 2007. Both report the same error message, and yes, I did install the software on both machines!

have you given up on me? :(

No.  Sorry, I've just been busy.  Try this version.  You'll need to include a reference to DSO OLE Document Properties Reader 2.1.  Here's how:

1.  Open the VB Editor (Alt+F11)
2.  Click Tools->References.
3.  Scroll through the list of references until you find that item.
4.  Check the box next to it.
5.  Click Ok.

Try the code again and let me know what happens.

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    Dim olkAttachment As Outlook.Attachment, _
        objFSO As Object, _
        objTempFolder As Object, _
        objFilePropReader As New DSOFile.OleDocumentProperties, _
        objDocProp As Object, _
        strFilename As String
    If Item.Class = olMail Then
        If Item.Attachments.Count > 0 Then
            For Each olkAttachment In Item.Attachments
                If Right(LCase(olkAttachment.FileName), 3) = "doc" Then
                    Set objFSO = CreateObject("Scripting.FileSystemObject")
                    Set objTempFolder = objFSO.GetSpecialFolder(2)
                    strFilename = objTempFolder & "\" & olkAttachment.FileName
                    olkAttachment.SaveAsFile strFilename
                    objFilePropReader.Open strFilename
                    Set objDocProp = objFilePropReader.SummaryProperties
                    If objDocProp.PageCount > 3 Then
                        Cancel = True
                        'Change the message on the following line as desired.
                        MsgBox "The Word attachment has too many pages." & vbCrLf & "This document has " & objDocProp.PageCount & " pages.  The limit is 3."
                    End If
                    objFilePropReader.Close False
                End If
            Next
        End If
    End If
    Set objDocProp = Nothing
    Set objFilePropReader = Nothing
    Set objTempFolder = Nothing
    Set objFSO = Nothing
End Sub

Super that works! How do I set it to only scan the attachment if the subject is "BLA BLA BLA"

thanks!

You're welcome.