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:
- Expand Project1 and double click on ThisOutlookSession.
- Copy then paste the macro into ThisOutlookSession. (Click within the code, Select All using Ctrl+A, Ctrl+C to copy, Ctrl+V to paste.)
- Make sure folder in the sDirectory path exists; if not, change it to a folder that exists.
- Click in the Application_Startup macro and press Run (or F8) to kick start it without restarting Outlook.
- 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