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
' //www.vboffice.net/en/developers/print-attachments-automatically

' 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

Print Attachments on Selected Messages

To convert the macro to print attachments on a selected messages as needed, you need to remove the startup and itemadd macros and either use code that picks up the selected item or loops through the selected items.

This version will work either one or more selected items.

' Based on macro written by Michael Bauer, vboffice.net
' //www.vboffice.net/en/developers/print-attachments-automatically
 
' use  Declare PtrSafe Function with 64-bit Outlook
Private Declare PtrSafe 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 Sub PrintAttachmentsSelectedMsg()
 Dim oMail As Outlook.MailItem
 Dim obj As Object
 'On Error Resume Next
 
For Each obj In ActiveExplorer.Selection
Set oMail = obj
 
  Dim colAtts As Outlook.Attachments
  Dim oAtt As Outlook.Attachment
  Dim sFile As String
  Dim sDirectory As String
  Dim sFileType As String
 
  sDirectory = "C:\Users\Diane\Docs\"
 
  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
  
Next
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

Run a script version

This code sample is used in a run a script rule and deletes the message after printing the attached pdf.

to use, add the macro to a module, create a rule with the conditions you want to use and select run a script as the only action then select this script. For more information, see Run a Script rules.

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
 
  
 Sub PrintAttachments(oMail As Outlook.MailItem)
  Dim colAtts As Outlook.Attachments
  Dim oAtt As Outlook.Attachment
  Dim sFile As String
  Dim sDirectory As String
  Dim sFileType As String
 
  sDirectory = "C:\Users\Diane\Documents\Attach\"
 
  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 ".pdf", ".doc", "docx"
 
        sFile = sDirectory & oAtt.FileName
        oAtt.SaveAsFile sFile
        ShellExecute 0, "print", sFile, vbNullString, vbNullString, 0
      End Select
    Next
    
  End If
     oMail.Delete
 

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