Macro to Print Outlook email attachments as they arrive

Last reviewed on October 28, 2013

Today's entry in the lazy programmer series involves tweaking the code sample at Attachment: Print received attachments immediately so that it works with 4-character extensions and also with 64-bit Outlook 2010 or 2013. (The original macro works with 32-bit Outlook).

For third party add-ins and utilities, see Print Email (and Attachments) on Arrival

The code looks at the last 4 characters, including the period and will work as long as you use 4 characters in each extension we want to check.

Case "xlsx", "docx", ".pdf", ".doc", ".xls"

To use the macro with 64-bit Outlook, you need to add PtrSafe to Declare:

Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias _

Print received attachments immediately code sample

Original code was written for 32-bit Outlook and 3 character file extensions.

To use, open the VBA editor using Alt+F11 and paste the following code into ThisOutlookSession. Edit the code as needed then click in the Application_Startup() macro and press Run button (F8). This starts the macro without the need to restart Outlook.

' Written by Michael Bauer, vboffice.net
' http://www.vboffice.net/sample.html?mnu=2&lang=en&smp=3&cmd=showitem

' use  Declare PtrSafe Function with 64-bit Outlook
Private Declare Function ShellExecute Lib "shell32.dll" Alias _
  "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
  ByVal lpFile As String, ByVal lpParameters As String, _
  ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Private WithEvents Items As Outlook.Items

Private Sub Application_Startup()
  Dim Ns As Outlook.NameSpace
  Dim Folder As Outlook.MAPIFolder

  Set Ns = Application.GetNamespace("MAPI")
  Set Folder = Ns.GetDefaultFolder(olFolderInbox)
  Set Items = Folder.Items
End Sub

Private Sub Items_ItemAdd(ByVal Item As Object)
  If TypeOf Item Is Outlook.MailItem Then
    PrintAttachments Item
  End If
End Sub

Private Sub PrintAttachments(oMail As Outlook.MailItem)
  On Error Resume Next
  Dim colAtts As Outlook.Attachments
  Dim oAtt As Outlook.Attachment
  Dim sFile As String
  Dim sDirectory As String
  Dim sFileType As String

  sDirectory = "D:\Attachments\"

  Set colAtts = oMail.Attachments

  If colAtts.Count Then
    For Each oAtt In colAtts

' This code looks at the last 4 characters in a filename
      sFileType = LCase$(right$(oAtt.FileName, 4))

      Select Case sFileType

' Add additional file types below
      Case ".xls", ".doc", "docx"

        sFile = sDirectory  & oAtt.FileName
        oAtt.SaveAsFile sFile
        ShellExecute 0, "print", sFile, vbNullString, vbNullString, 0
      End Select
    Next
  End If
End Sub


Print attachments then move the message

If you want to print the attachment then move the message to another folder, you'll either need to add the move code to the ItemAdd macro or add another macro and call it from the ItemAdd macro.

In this example, I'm adding a new macro and calling it from the ItemAdd macro, after the PrintAttachments macro is called.

  If TypeOf Item Is Outlook.MailItem Then
    PrintAttachments Item
    MovePrintedMail Item
  End If

At the end of the module, after the PrintAttachments macro, add the move macro. This macro assumes the "move to folder" is a subfolder of the Inbox. Don't forget to change the mailbox name, using the name as it appears in the Folder list (it's your email address in newer versions of Outlook).

Sub MovePrintedMail(oMail As Outlook.MailItem)
  Dim objDestFolder As Outlook.MAPIFolder

   Set objDestFolder = Session.Folders("mailbox name")._
     Folders("Inbox").Folders("Printed")

     oMail.Move objDestFolder 
   
  Set objDestFolder = Nothing
End Sub

 

Use Acrobat's Printer Options

If you own Adobe Acrobat, you can set the pages you want to print and "shrink to fit" using the PrintPages function of Acrobat:
Function PrintPages(nFirstPage As Long, nLastPage As Long, nPSLevel As Long, bBinaryOk As Long, bShrinkToFit As Long) As Boolean

To use Acrobat's object model, you need to set a reference to Acrobat in the VB Editor's Tool, References dialog box.

This will not work with Reader, you need to own Acrobat. I tested it with Acrobat X but it should work with any version of Acrobat. To the best of my knowledge, both Acrobat Standard and Acrobat Pro include OLE support.

Change the Select Case code in the PrintAttachments macro to the following. If you are only printing PDF files, you can remove the Case statement that prints Excel and Word files.

To print no more than first 2 pages, use AcrobatPrint sFile


      Select Case sFileType

' Add additional file types below
      Case ".xls", ".doc", "docx"
 
        sFile = sDirectory & oAtt.FileName
        oAtt.SaveAsFile sFile
        ShellExecute 0, "print", sFile, vbNullString, vbNullString, 0
        
' Print PDF
     Case ".pdf"
        sFile = sDirectory & oAtt.FileName
        oAtt.SaveAsFile sFile
        AcrobatPrint sFile, "All"


      End Select

After changing the Select case block, add the AcrobatPrint macro to your module, inserting it after the PrintAttachments macro.


Public Sub AcrobatPrint(FileName As String, PrintMode As String)

     Dim AcroExchApp As Acrobat.CAcroApp
     Dim AcroExchAVDoc As Acrobat.CAcroAVDoc
     Dim AcroExchPDDoc As Acrobat.CAcroPDDoc
     Dim num As Integer

     Set AcroExchApp = CreateObject("AcroExch.App")
     Set AcroExchAVDoc = CreateObject("AcroExch.AVDoc")

     ' Open the pdf file
     AcroExchAVDoc.Open FileName, ""

     Set AcroExchPDDoc = AcroExchAVDoc.GetPDDoc

     ' Get the number of pages for this pdf
     ' Subtract one because the count is 0 based
     num = AcroExchPDDoc.GetNumPages - 1

     If PrintMode = "All" Then

     ' Print Entire Document 
     ' Last value is shrinktofit
           Call AcroExchAVDoc.PrintPages(0, num, 2, 1, 1)
     Else
           If num = 0 Then
               ' If one page, print document
                Call AcroExchAVDoc.PrintPages(0, num, 2, 1, 1)
           Else
               'Print first two pages
                Call AcroExchAVDoc.PrintPages(0, 1, 2, 1, 1)
           End If
     End If
  
     AcroExchApp.Exit
     AcroExchAVDoc.Close (True)
     AcroExchPDDoc.Close

End Sub

How to use macros

First: You will need macro security set to low during testing.

To check your macro security in Outlook 2010 or 2013, go to File, Options, Trust Center and open Trust Center Settings, and change the Macro Settings. In Outlook 2007 and older, it’s at Tools, Macro Security.

After you test the macro and see that it works, you can either leave macro security set to low or sign the macro.

Open the VBA Editor by pressing Alt+F11 on your keyboard.

To use the macro code in ThisOutlookSession:

  1. Expand Project1 and double click on ThisOutlookSession.
  2. Copy then paste the macro into ThisOutlookSession. (Click within the code, Select All using Ctrl+A, Ctrl+C to copy, Ctrl+V to paste.)
  3. Make sure folder in the sDirectory path exists; if not, change it to a folder that exists.
  4. Click in the Application_Startup macro and press Run (or F8) to kick start it without restarting Outlook.
  5. Send yourself a message with a Word document attachment. Outlook should print it on arrival.

More information as well as screenshots are at How to use the VBA Editor

Written by

Diane Poremsky
A Microsoft Outlook Most Valuable Professional (MVP) since 1999, Diane is the author of several books, including Outlook 2013 Absolute Beginners Book. She also created video training CDs and online training classes for Microsoft Outlook. You can find her helping people online in Outlook Forums as well as in the Microsoft Answers and TechNet forums.

If the Post Coment button disappears, press your Tab key.