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:
- 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
ramesh says
Dear ,
how can solve it .
Diane Poremsky says
No, you can't change the printer in Outlook.
You can try changing the default before printing - then change it back.
Dim Wsh As Object
Set Wsh = CreateObject("WScript.Network")
Wsh.setDefaultPrinter "the printer name"
repeat the lines above with the usual default printer name to change it back.
ramesh says
Thanks diane, for the reply , it is working , but is it possible to right a program to execute this , means that find the default printer on before and save as string , change later it as default.
it is much appreciated .
Best regards
Sridar says
HI
Kindly provide code to print the attachment in ascending order based on the first 11 Digit of the attachment name .
Diane Poremsky says
the attachments will be printed in the order the attachment's app processes and renders them - to control the order you would need to use a 3rd party utility.
David Sivewright says
Im getting a syntax error. with this.
Sub MovePrintedMail(oMail As Outlook.MailItem)
Dim objDestFolder As Outlook.MAPIFolder
Set objDestFolder = Session.Folders("ap@hipco.com").
Folders("Inbox").Folders ("Printed")
oMail.Move objDestFolder
Set objDestFolder = Nothing
End Sub
Diane Poremsky says
Which line is erroring?
Carl says
How would the VBA code be modified to include situations when the email message has another email message as an attachment and that second email message has the pdf, etc. file attachment that you want to automatically print?
Diane Poremsky says
You would need to open (using .display) the second email than use application.ActiveInspector.CurrentItem to reference it - then you can open the attachment
Carl says
Thank you!
Patrícia Costa says
Hello!
I would like to print the PDF file from certain emails (with the same subject), also, in this file I just want to Print the second page. How should I proceed to create this rule and Macro?
Thank you,
Patrícia
Diane Poremsky says
The first 2 numbers in this line are first page to print, last to print - but the page numbers are zero-based - so 0 = page 1, 1 = page 2. Therefor, you use 1,1 as the first 2 numbers to print only page 2:
Call AcroExchAVDoc.PrintPages(1,1, 2, 1, 1)
https://www.poremsky.com/office/print-pdf-vba/
Alex Gamboa says
I am currently using a trial version of the EZDetach add-in for outlook to automatically save attachments from incoming emails onto a folder on my desktop and then automatically print those attachments. I am trying to find a way to filter through those attachments to be able to auto print three different types of invoices to three different colors of paper. I either want it to auto print to different trays or purchase more printers and have each invoice print to a different printer. Please let me know if this is possible
Joe says
Will this code work with Nitro Pro?
Diane Poremsky says
It might, since it just calls up the default application and uses shell commands. I dont have nitro to test it though.
Steven says
I am using the script to print then delete the attachment, but it seems that it is double printing some of them and not printing others. The odd thing about this is that they all show up in the deleted folder as they should and in the order they should with no duplicates. Very strange. Any ideas?
Logan says
Diane,
I am new to macros and am attempting to set one up that opens a PDF and prints the first page within the pdf while deleting the email out of outlook and archiving it on the computer within a specific file. I have had success with the printing, archiving, and deleting. However, I am not able to get the first page within the PDF to print only, merely all pages are printing. I noticed in a thread you mentioned the adobe OLE support needed to be a full version and the acrobat reader (my current version) may not work. I was wondering if there was another way to set it up.
Thanks,
Logan
Diane Poremsky says
You'll need to use a pdf product that supports VBA and that lets you control the pages that are printed. If you don't have Acrobat, it might work to use word as the pdf application but i'm not sure how fast it will be or if the printout will be poorly formatted.
Venkayya says
Hello Diane:
First of all THANK YOU very much for your article. It saved us a lot of time.
We have a requirements to login to different common mailboxes and print the PDF statements. Our users typically have a set of common mailboxes , any help on how to login to different mailbox within the script and move the mail to a different folder in that mailbox .
Appreciate your help
I.M. says
Hi Diane,
Is there a way to setup Oulook 2016 to allow just this one macro to p rint outlook email attachments as they arrive? Every time I start Outlook it will request me authorisation to enable macros. I understand the risks of enabling all macros, hence my question.
Diane Poremsky says
Macros are all or nothing - however, it is all but impossible for someone to add a macro to outlook without your knowledge - they would need to replace the VBA project file but the file is not "live" until you open the VBA editor.
I.M. says
Diane, no words to thank you. It works now without a hitch. Thanks! :-)
I.M. says
Diane, thank you very much for this macro. I have installed it (macro text attached to this post) and setup a rule for it to print only emails received by a certain email account https://diigo.com/0a6t83
Everything seems fine and it works. But it is printing attachments from emails received in all email accounts in my Outlook 2016. Clearly, the rule is not working.
Is there any way to fix this? Any advice is welcome. :-)
Diane Poremsky says
the rule is for messages sent to an address, so it should apply to all messages sent to that address - if you have multiple accounts, you'd use a rule for 'through specified account'. If you are forwarding/ redirecting mil sent to other addresses to this address the rule is seeing the new address, not the original one.
FWIW, its recommended that you not use other actions in the script - the play a way should be moved to the script.
Chriss says
Hi,
i use Outlook 2016 64bit. The files are not in my directory. Another problem is that the E-Mail and the attachments are printed. Can you help me?
Diane Poremsky says
>> the files are not in my directory.
This directory? sDirectory = "D:\Attachments\"
Add debug.print sFile as a line right after sFile = sDirectory & oAtt.FileName
then look in the immediate window (View menu) to see what path you are using.
Are you also using a rule to print the message? This macro should only print the attachments.
Pascal Bilat says
Hi Diane,
I have just tested the macro Print Attachments on Selected Messages! I have only added 2 little changes as You can see. The macro runs very well. Thank You very much
My problem:
My problem is, when I select a message (with attachments), I have to press Alt+F8 and then click on "Run"
Question:
Is it possible to place a button on the ribbon to run this macro after selecting the message; If Yes, how can I add this button?
Option Explicit
' 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:Temp"
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", "xlsx", ".doc", "docx", ".ppt", "pptx", ".pdf"
sFile = sDirectory & oAtt.FileName
oAtt.SaveAsFile sFile
ShellExecute 0, "print", sFile, vbNullString, vbNullString, 0
End Select
Next
End If
Next
End Sub
Best regards,
Pascal Bilat
Diane Poremsky says
Yes, you can create a button - change private in private sub printattachments..... to public. The right-click on the ribbon and choose customize. Select macros in the drop down on the left, find the macro and add it to the ribbon. Procedure is the same for the quick access toolbar. More info here - https://www.slipstick.com/developer/how-to-use-outlooks-vba-editor/
Cristina says
Hi Diane,
Do you also have a macro to print e-Mail and attachement upon arrival?
The macro to print attachments works perfectly; but could figure out a way to print the e-Mail too.
Many thanks in advance.
Cristina
Diane Poremsky says
Add item.PrintOut before PrintAttachments Item line. Note that if you are printing multiple messages at once, that the messages and their attachments may be out of order due to how much rendering time the attachments need.
Rene says
Hello,
I am having the following trouble trying to use the macro with the move to folder add on.
When the email arrives debugging is stating an Compile Error invalid character.
Debug is not liking the "._" at the end of the line of code:
Set objDestFolder = Session.Folders("xxxx@abc.com")._
How should the code be modified to work correctly? This is with Outlook 2013.
Diane Poremsky says
That _ means the line continues - there is probably an extra (or missing) space somewhere. you can make it all one line:
Set objDestFolder = Session.Folders("mailbox name").Folders("Inbox").Folders("Printed")
Rene says
That corrected that problem, but now it is moving all emails to the printed folder.
Is there a way to set it to only move files that had an attachment and that it printed to the folder and leave an email without an attachment in the Inbox?
Diane Poremsky says
you need to use an if statement in that macro to see if the item has attachments.
if item.attachments.count > 0 then
'print
'move
end if
the only issue is that it will pick up images in signatures - you can either check for file names or file types if you only need to print certain attachments. The macro at https://www.slipstick.com/outlook/email/attachment-missing-from-outlook-message/ shows how to check for file size and attachment names.
Rene says
Came up with this and it works perfectly
' 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
Dim Should_Move As Boolean
sDirectory = "C:Attachments"
Set colAtts = oMail.Attachments
Should_Move = False
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", "xlsx", ".doc", "docx", ".pdf"
sFile = sDirectory & oAtt.FileName
oAtt.SaveAsFile sFile
ShellExecute 0, "print", sFile, vbNullString, vbNullString, 0
Should_Move = True
End Select
Next
End If
If Should_Move = True Then
Dim objDestFolder As Outlook.MAPIFolder
Set objDestFolder = Session.Folders("mailbox_name").Folders("Inbox").Folders("Printed")
oMail.Move objDestFolder
Set objDestFolder = Nothing
Else: End If
End Sub
David says
Thanks for providing this macro - it's saving us a lot of time!
We are having a few problems with it though...
1. Attachments printing out of order - I have read through the comments below and this seems to be due to rendering of documents. Does this mean that the macro doesn't wait for the print function to complete (ShellExecute) before moving on to the next attachment or message? Is there a parameter or alternative that will force it to wait? Alternatively can we add a delay to the macro to give the print function a chance to complete?
2. Occasionally we will dump a number of emails into the print folder and the macro will process the first email and then not continue with the rest. They will then have to keep moving the emails out and back into the folder to print them all. Any ideas?
Diane Poremsky says
Correct, it doesn't wait - it sends the document to the program and tells it to print it then moves on. I'm not aware of a specific wait parameter but you could add delays to give it time to print, but this will slow things down. Sperry Software's addin can hold the documents and print in order.
I'm not sure why it wouldn't pick up more than one message, unless you dumped a lot (like more than 5 or 10).
David says
Thanks Diane. I will check out Sperry. With regard to it stopping after the first message sometimes they tend to dump up to 50 messages at a time. I might try to debug the code when this happens to see what it's doing.
Thanks again for your help, much appreciated.
Diane Poremsky says
It could be too many messages...
Сергей says
Пожалуйста помогите. При распечатки документов с Outlook печать файлов excel не размещается на одном листе. Как сделать что бы по умолчанию работала функция "Разместить печать не более на одном листе."?
Please help. When printing from Outlook to print excel files are not hosted on a single sheet. How to make that the default function would "Place the printer does not print more than one worksheet at a time. "?
Diane Poremsky says
That would be handled by Excel - not sure if you could add vba to this macro that if excel document, to set the print options. It really depends on if the print options can be controlled by VBA in Excel. An Excel startup macro might work too.
Stian says
Hello,
How can I specify that I would like to run this script only when receiving emails from a specific person with a specific subject?
Regards
Stian
Diane Poremsky says
Use the run a script version and create a rule for messages from that person.
Luka says
Im using this script.
It doesnt quite work for me. I need to print out attachment 2 times and i made 2 rules for it.
But here is the problem. It prints out 1 copy than reports an error: 75 - Path/File access error
and after i klik ok it prins another copy.
Poit is i need 2 copies in order so now i have to manualy put right copies together.
I need it to ship goods to stores and thay order alot each day so i get like 50 to 100 mails for orders, with attachments.
I would like for outlook to automaticly print every attachment 2 times in order.
Diane Poremsky says
Did you try repeating this line in the macro:
ShellExecute 0, "print", sFile, vbNullString, vbNullString, 0
Raul Al says
Hi Diane,
I am new to macros in Outlook and I can't seem to figure out how to get a macro to work. Is there a macro to automatically print a select group of emails along with any attachments and hyperlink content sequentially to a specific printer. These emails sometimes have an attachment only, hyperlink only, or both. I would like the macro to automatically open hyperlink and print hyperlink files and then close the website. Hyperlink files can range from PDF, JPEG,. DOC,. DOC, PNG, Etc.
I've been doing this and it's very time consuming ?? Thanks for your help and time!
Diane Poremsky says
Sorry I missed this earlier, I'm way behind. I don't have a macro that will open a hyperlink and print (but i have one that opens hyperlinks) - the problem is once it's open, it's in control of the browser, not outlook. I don't know if any of the print addins (such as the one from sperry software) can open and print hyperlinks.
matt geerdes says
Hello, what changes do I make in the PRINT ATTACHMENTS immediately code so both of my outlook email accounts print? My default email is on an exchange address and this prints fine however my gmail account does not print? Thank You!!!
Diane Poremsky says
This tells it to watch the default inbox:
Set Folder = Ns.GetDefaultFolder(olFolderInbox)
You'd need to duplicate and edit the necessary lines to watch the other folder (set gmailFolder, set gmailItems, & the private statement) then duplicate the itemadd code. You'll need the function at https://www.slipstick.com/developer/working-vba-nondefault-outlook-folders/#GetFolderPath.
Private WithEvents gmailItems As Outlook.Items
Dim gmailFolder As Outlook.MAPIFolder
Set gmailFolder = GetFolderPath("me@gmail.com\Inbox")
Set gmailItems = gmailFolder.Items
Private Sub gmailItems_ItemAdd(ByVal Item As Object)
If TypeOf Item Is Outlook.MailItem Then
PrintAttachments Item
End If
End Sub
Troy Hannon says
Hi,
I am new to Outlook. I would like to implement this in the Outlook 2016 client (as well as the O365 online version if possible). What steps to I need to take to make that happen?
Thanks!
Diane Poremsky says
it will work as written with outlook 2016. it will not work in outlook on the web - macros are 'client-side'.
Dusko says
Hi Diane,
can you help me please. I pasted "Run a script version" , made rule, but nothing happens.
When I checked routine it turns out that colAtts.Count is always 0, no matter how much attachements I have in mail.
Why oMail don't have any attachment ?
( oMail.Subject can show subject of message, so I suppose oMail contain received mail, but not his attachment)
I'm working on Outlook 2010 - 32-bit / Win 10
Thank you in advance !
Diane Poremsky says
Do the messages have the attachment paperclip? There are some mail servers that corrupt the attachment collection and that would prevent it from working.
M.S. says
Hi,
I've the same problem.
Windows 10 64-Bit
Outlook 2010 32-Bit
Did you solved the problem?
matt says
Respected!
Please help me with starting this. I'm on Outlook 2013 x64.
At first, where i have to place this code to work? If i put it in a new module, then i can not run it, because it wants a macro. if i put it in thisoutlooksession, then i can debug it, if i click on the sub. It saves the attachment, but not prints. Thank You!
David says
I am trying to use this as a script. I have copied and pasted it as a module in Outlook, changed the directory, and added the file extension ".pdf".
I made a rule to run this script when the emails with attachments I want printed arrive.
I get an error message.
This is what I have in Outlook under Module 1:
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:Ewp"
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", ".pdf"
sFile = sDirectory & oAtt.FileName
oAtt.SaveAsFile sFile
ShellExecute 0, "print", sFile, vbNullString, vbNullString, 0
End Select
Next
End If
End Sub
Any help would be appreciated. I know nothing about Basic.
Diane Poremsky says
what is the error message?
oh, is this a typo? sDirectory = "C:Ewp" - it should be "c:\ewp".
Andreas Morawitzky says
Hey Diane,
I'm trying to use this code with a shared mailbox in Outlook 2013. I used the GetFolderPath, wich seems to work fine, but when it should Set Items, I get a Runtime Error 91.
I have not changed anything but the Folder location, any clues?
Jesse says
What would I need to add (and where) in order for this to clean up the files (delete) after they are printed?
Thank you. This is working nicely.
ims892919 says
Is there any way to have the script you created for vba print out an email an email with a pdf attachment but only print the page that contains "total" text in terms if net dollars for a particular vendor, problem is we get reports that are many pages and I only want to print out a specific item (almost all the time the one I am looking for is the page that contains "total")
Diane Poremsky says
I'm not aware of a way to do that - you are limited to saving and printing -in some cases, you can print a page # but it would always be the same page, not one with specific text on it. Sorry.
ims892919 says
how would I print the page number then if you could elaborate please?
:)
Diane Poremsky says
it depends on the application how it would be done, the code on this page won't work because you can't send page# to shellexecute. Acrobat can print a page, word and excel can but you print from within those apps instead of using shell.
Erdem says
Dear Diane
Also, I tried to use just htm files to print then got below error message,
Run-time error '2147417848 (80010108)':
Automation error
The object invoked has disconnect from its clients.
Diane Poremsky says
Does the folder the attachments are saved to exist:
sDirectory = "D:\Attachments\"
if not, you'll get an error.
Erdem says
Thanks Diane,
I tried to use new code but nothing changed. Process is working then selected files is backup but nothing printed.
Actually, all file extension is html not htm. May be that is useful thing for your code. I hope, we can find a solution. Thanks a lot for your help.
Diane Poremsky says
Use If sFileType = "html" Then for HTML file types. The code checks the last 4 characters in the filename - so you'll use Case "xlsx", "docx", ".pdf", "html" and also in the If statement.
eddielordjr says
This is exactly what I'm looking for, thank you! I used to program in VB back in the day but am a bit rusty now.
I already direct all mail with attachments I want to print to a specific folder. Instead of moving the mail after print, I would rather just mark it as read. Also I don't want it automatically deleting anything. Is there a way if the print failed to have the script keep that message as unread or flag it and then continue onto the next? Some of the attachments require an additional step to be opened and I'm sure would fail with the script and I would like to know which ones they were so I can go back and manually print.
Thanks again for the code, I can't wait to start testing it!
Diane Poremsky says
Read state is easy .unread = true or false but detecting if the printout worked is difficult to impossible. You can use exit the sub on error - if the change to read is last, it would be skipped if the macro failed, but once it's sent to the printer, outlook sees it as complete.
Erdem says
Dear Diane,
Firstly, I am very appreciate for your help. Scrip is working but I cannot print the html files. For example xls,xlsx,doc,docx etc extensions are working very well. When I tried to print html files then script is working and files put the sDirectory but nothing happened. The codes are as below. What can I do print the html files ?
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:\Copy\"
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", "xlsx", ".doc", "docx", "html", ".htm"
sFile = sDirectory & oAtt.FileName
oAtt.SaveAsFile sFile
ShellExecute 0, "print", sFile, vbNullString, vbNullString, 0
End Select
Next
End If
Next
End Sub
Diane Poremsky says
i added some if code to look for .htm after saving the file -
sFile = sDirectory & oAtt.FileName
oAtt.SaveAsFile sFile
If sFileType = ".htm" Then
Dim objIE As Object
Set objIE = CreateObject("InternetExplorer.Application")
objIE.Visible = True
objIE.Navigate sDirectory & oAtt.FileName
Do While objIE.ReadyState <> 4
Loop
objIE.ExecWB 6, 2, "", ""
objIE.Quit
End If
ShellExecute 0, "print", sFile, vbNullString, vbNullString, 0
Henry says
Hello Diane,
I created a folder under inbox with a name "Printed". Every incoming email with pdf attachment will be printed automatically and the printed email will automatically moved to the "Printed" folder. So far so good until today.
Yesterday I received 20 emails with pdf attachments and it automatically printed out, automatically moved to the "Printed" folder and as usually I delete it.
Today I found out that 20 the same unread emails of yesterday in the "Printed" folder but it don't print out.
Please help me.
Thanks in advance
Best regards,
Henry
Diane Poremsky says
is the macro running? Double check the settings in File, Options, Trust Center, Macro Settings. If you didn't sign the macro, it needs to be set to low.
Jason says
With "Run a script version", is it possible to edit the script to have the second page printed of the attachment if its a excel workbook?
Diane Poremsky says
possibly, but i don't have any code samples that do it. Sorry.
William says
Diane,
Let me first thank you for this wonderful code, and for the implicit instructions on it's use.
I'm having a slight issue, though. Most of the attachments that we receive are in the form of .jpg or .tif (mostly jpg). In using Windows 7, even when I've selected the default program for opening to something other than windows photo viewer (in my case, IrfanView), when an email comes across that has a .jpg attachment, the windows photo viewer/printer still appears asking for confirmation to print attachments.
Is there any way on God's green earth to bypass this or skip this? By the way, I'm simply using the first script you have on this thread, modified to fit my folder's path as well as to add the .jpg and jpeg file types.
Thanks in advance for your time!
William says
Or possibly just a way to convert them from .jpg to another file type automatically so that they can be printed automatically as they arrive without the need to process through Windows Photo Viewer?
Diane Poremsky says
converting to a different file type is would be more difficult unless irfan view can do it via command line.
Diane Poremsky says
I will look into it - outlook should use the default settings and print via irfanview.
William says
Unfortunately, Windows 7 does not use the default program. I've set IrfanView as the default program for all .jpg, .jpeg, .jpe, etc images already. This is a known issue with Windows 7 that has not been fixed. All images end up going through Windows Photo Viewer/Printer rather than the default program. It is the same issue I always run into by right clicking a file attached to an email in Outlook and clicking "Quick Print". It automatically opens in Windows Photo Viewer/Printer.
William says
Did you by chance every figure anything out with this one?
Diane Poremsky says
No, not yet.
William says
I'm still having this same issue (which persists through Windows 10 as well). When you attempt to have this macro run, it still opens in the Windows photo viewer (even though I have IrfanView set as the default application to open .jpg and .jpeg files). It will not move forward until I manually click on the print option in this dialog box.
Is there a way to make this macro actually open the file (.jpg or .jpeg) in the default program, print in the default program, then close the file and move the email to another folder? Here is why I'm asking this: When you right click on an attachment and click quick print or if you use the macro above, it opens the file in Windows Photo Viewer/manager. If you double click to open the file normally, it opens in IrfanView. When printing in IrfanView, the Windows photo viewer does not appear at all.
Diane Poremsky says
The print command is using the photo viewer - I don't recall how to change it in the newer windows - they did a good job of hiding it.
marius says
Hi,
I have a situation : when an email arrives in an office shared mailbox, i must print the attachment... but i made a mistake and i have printed an email from yesterday. Is there a way to make a vba to warn me if i print an attachement from previous days from that mailbox ?
Tahnk you.
Diane Poremsky says
Not tested... but you could add a date checker to this (might need to format the date)
Private Sub Items_ItemAdd(ByVal Item As Object)
If TypeOf Item Is Outlook.MailItem Then
If item.receivedtime = date then
PrintAttachments Item
End If
end if
End Sub
Hassan Al-Rubaie says
Diane,
Like everyone else I'm very grateful for this code you have posted!
It run for me, but instead of just printing and going about it's business, I'm getting the printer confirmation screen. So I then have to tell it "ok" for it to print. Do you know any way around this? I'm guessing this might be a Windows XP related issue.
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", ".html"
sFile = sDirectory & oAtt.FileName
oAtt.SaveAsFile sFile
ShellExecute 0, "print", sFile, vbNullString, vbNullString, 0
End Select
Next
End If
End Sub
Thanks in advance for your assistance!
Diane Poremsky says
I don't know why its bringing up a screen - unless your security settings require it (such as running outlook as an administrator or disabling UAC). Click Yes script can answer the dialog for you.
Jacob says
Hi Diane,
I am not able to get the code to print the attachments in the shared email folder. I have the below code, but I don't believe it is finding the correct folder to print from. Also I am not sure if the coding for moving the email to the "printed folder within the shared folder coding will work.
' Written by Michael Bauer, vboffice.net
' https://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 objOwner As Outlook.Recipient
Set NS = Application.GetNamespace("MAPI")
Set objOwner = NS.CreateRecipient(".Automated Invoices")
objOwner.Resolve
If objOwner.Resolved Then
'MsgBox objOwner.Name
Set newCalFolder = NS.GetSharedDefaultFolder(objOwner, olFolderCalendar)
End If
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 = "C:\printed 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", ".pdf", "tiff"
' add to top of macro with other dim's
Dim dtDate As Date
Dim sName As String
dtDate = oMail.SentOn
sName = Format(dtDate, "hhnnss", vbUseSystemDayOfWeek, vbUseSystem)
sFile = sDirectory & sName & oAtt.FileName
oAtt.SaveAsFile sFile
ShellExecute 0, "print", sFile, vbNullString, vbNullString, 0
End Select
Next
End If
End Sub
Sub MovePrintedMail(oMail As Outlook.MailItem)
Dim objDestFolder As Outlook.MAPIFolder
Set objDestFolder = Session.Folders("AutomatedInvoices@mhctruck.com")
Folders("Inbox").Folders ("Printed")
oMail.Move objDestFolder
Set objDestFolder = Nothing
End Sub
Diane Poremsky says
Remove the ' from MsgBox objOwner.Name line and see if the owner name comes up when it runs. If you are watching the inbox, you need to change this line:
Set newCalFolder = NS.GetSharedDefaultFolder(objOwner, olFolderInbox)
Or try using this line as the watch folder and the getfolderpath function.
Set newCalFolder = getfolderpath("AutomatedInvoices@mhctruck.com\Inbox")
Ashley says
I have adopted this code to also work for a shared folder, but I want a folder within the Inbox. I have in my code:
Set newCalFolder = NS.GetSharedDefaultFolder(objOwner, olFolderInbox).Folders("PRINT")
"But it comes up as the attempted operation failed. An object could not be found."
Can I not reference a folder within the shared inbox?
Thanks for the help,
Ashley
Diane Poremsky says
FOR A subfolder of the Inbox, try this (calendar is olFolderCalendar)
dim newSubfolder as outlook.folder
Set newCalFolder = NS.GetSharedDefaultFolder(objOwner, olFolderInbox)
Set newSubfolder = newcalfolder.("Print")
kyleivanblake says
What happened to all of the comments?
Diane Poremsky says
Good question. Thanks for letting me know... now off to figure out what happened.
Webmaster says
I have no idea what happened to the database, but the comments should be working again now. Thanks again for alerting me.
kyleivanblake says
Diane, I appreciate everything you do for the IT community!
I have another question, can make the macro print two of each attachment instead of just one?
Diane Poremsky says
You would need to loop through it twice as Outlook can't set the number of copies.
kyleivanblake says
If I have Outlook 2010 or newer, and I have multiple Mailboxes configured in Outlook, is there a way to have this script only execute for one of the Mailboxes?
Diane Poremsky says
Sure. It watchs for new messages to arrive in a folder and simply changing this line:
Set Folder = Ns.GetDefaultFolder(olFolderInbox)
will make it watch a different folder. if the folder is in another mailbox, you'll use
Set Folder = GetFolderPath("other account\inbox")
See https://www.slipstick.com/developer/working-vba-nondefault-outlook-folders/ for more information and the getfolderpath function.
kyleivanblake says
This worked great, thank you for your help!
Jeffrey says
Hello Diane,
First, thanks for the great help that you provide.
But here is my question. How do i manage to use this in a rule? What sub should i call ?
No scripts appears in the list...
Here is my code :
' Written by Michael Bauer, vboffice.net
' https://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 = "C:\Users\jeffrey.desouche\Documents\"
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", "xslx"
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
Next
End If
End Sub
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
When i launch step by step Application_Startup() there is no error. Then i Run it but nothing happen, even with a message box.
Can you help me? :)
Thanks in advance
Jeffrey says
Edit is not possible so i reply.
I don't know how but it seems to work by now.
Except for the PDF part. So i added ".pdf" to the first Case, the fact is that doesn't close adobe.
Thanks
Diane Poremsky says
To use it in a rule, change Private PrintAttachments(oMail As Outlook.MailItem) to Public PrintAttachments(oMail As Outlook.MailItem) then create a run a script rule and select the PrintAttachments script, although that is not necessary as his macro: Private Sub Items_ItemAdd(ByVal Item As Object) runs it when new messages are added to the Inbox. Running application startup just tells outlook to start watching the folder - drag a message that has an attachment into the inbox to test it.
Cindy says
Is there any way to print only the first page of the pdf if you only have reader?
Diane Poremsky says
No, not to my knowledge. Sorry.
Robert says
Will this work for pop mailbox and how would i get this to work if i had know idea how to do a macro?
Diane Poremsky says
It will work with POP3 mail. See https://www.slipstick.com/developer/how-to-use-outlooks-vba-editor/ for instructions to use the VB Editor - its a little more detailed than the instructions at the bottom of the article.
Orson Carte says
Hey!Thanks for the Info. MARCO is working! Please let me know, if there is any chance to move the email to a different folder, called "already printed", after the mail has been printed out.
Diane Poremsky says
you can move it - there is a section that has a macro to move it.
In the MovePrintedMail macro, the folder path is entered - there are a few ways of calling the folder.
this example moves it to a folder under the inbox:
Set objDestFolder = Session.GetDefaultFolder(olFolderInbox)._
Folders("already printed").Items
oMail.Move objDestFolder
Felix says
The MACRO is working with security set to low. It's just that the files aren't getting attached to the mail previsualization like they're supposed to. The same MACRO was tested on other PCs and it works perfectly fine. It might be an option that is disabled on her version of EXCEL. Do you have any idea might cause this?
Diane Poremsky says
I'm not sure what mean about the files not getting attached as this macros prints attachments as they arrive, so they should be already attached.
Brandon Cole says
Thanks Diane; I spent way - way too much time trying to make something work here with code and came to the conclusion it would be very difficult code since the programs called range from Auto-CAD, to Photo Shop and everything in between. Code locks up in some cases, prints out of order usually (rendering issue as you said), or incompletely when computer/printer bites off more than it can chew so to say as the 300+ files hit the queue. I will investigate Sperry Software as you have suggested.
Best Regards Brandon
Diane Poremsky says
This is the sperry addin: https://www.sperrysoftware.com/Outlook/Print-On-Demand.asp - it has a 14 day trial so you can see if it will meet your needs. If you decide to buy it, I would appreciate you using this code at checkout - WD9BHK53 - so this site gets credit for it. Thanks. :)
Felix says
Hi Diane, thanks for you help. The macro I'm using normally attach files to an email. It works on every PC we've tried except one. The PDF just won't join the message. Is it a matter of security level or any other or macro settings particularly to this person's excel version? She is using the same Excel 2010 as the rest of us.
Thanks!
Diane Poremsky says
Any error messages? Is macro security set to low? If you step through it, what happens?
Frankie cheung says
Could it use a designated printer rather than the default printer? thanks.
Diane Poremsky says
No, not easily - you can't change it using Outlook VBA.
Frankie says
Thanks.
Could it save the mail messages to hard drive after printed and remove from the inbox?
Diane Poremsky says
Yes, you can do that. The code here: https://www.slipstick.com/developer/saving-messages-to-the-hard-drive-using-vba/ saves the message to the hartd drive. To delete the message from outlook, use mItem.Delete
Brandon Cole says
Deane
I would like to modify the code so I can print a selected string of many emails as such message 1 + attach 1 then message 2 + attach 2 and so on. I get a lot of project emails and have to print the message and attachment and want to keep them in order. The code you have shared seem to be close to that.
Brandon
Diane Poremsky says
You'll need code to print the message then call the code to print the attachment - the only problem is that the applications sends files to the printer as they are rendered, so they might get out of order (assuming you select several messages and attachments). Sperry Software's print add-in can handle this.
TomEnns says
I don't see my comment showing up i hope it wasn't deleted :/ But I will rephrase in short: Is there any way to get this to work with the currently selected mail item only instead of on all new items in the mailbox?
Thanks
Diane Poremsky says
it wasn't deleted. Comments are held for approval until I'm ready to reply, otherwise they get lost. As long as its not spam, it'll be approved.
For Each oMail In ActiveExplorer.Selection *should* work, but I'll check the code.
TomEnns says
I'm really sorry :/ I didn't realize that part though I see the yellow writing now. Thanks for looking into it.
TomEnns says
I figured out the issue, I didnt have a second "Next" now it works great :) Thankyou so much !
I do have a different question though, Is there a way to print out an 11"x11" page in landscape instead of printing letter size portrait?
Diane Poremsky says
Yeah, using 'Next helps a lot. :) The printer options are handled by the printer or the application and outlook can't easily control it. For word and excel files, you might be able to pass code to the application to set it. Other programs need to use windows functions to set it. Unfortunately, I don't have any code samples that do that.
TomEnns says
Ok well, I appreciate the help, and the new Code for selected items. This works better than I could have hoped for :)
TomEnns says
Hello, first of all thank-you for the knowledge :)
I am having a slight issue. I would love to use your code but I want to be able to call it manually on a selected email. I tried changing it up to look like this:
[code][/code]
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 PrintAttachments()
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
Dim oMail As Outlook.MailItem
For Each oMail In ActiveExplorer.Selection
sDirectory = "C:\TempAttachments"
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
[code][/code]
As you can see I removed the AddItems and ApplicationStartup events and changed the code to run as a regular macro. It runs without error but it also does nothing :/
Im very new to VBA so this is all I could come up with. Any chance you could give me a hand in switching it up so it works? It would be very much appreciated.
Thanks!
Diane Poremsky says
To print one message: keep private declare lines and remove private with events and the startup and itemadd macros. Replace top of print macro with this:
Private Sub PrintAttachments()
Dim oMail As Outlook.MailItem
'On Error Resume Next
Set oMail = Application.ActiveExplorer.Selection.Item(1)
to work with a group of selected messages, use this at the top of the print macro instead.
Private Sub PrintAttachments()
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
Diane Poremsky says
As an FYI, I added the code for a selected items macro to the page
ND says
How would you open an email as it arrives then save it to a different location then close it and mark it as unread?
Diane Poremsky says
You need to mark it unread after doing all that. You can use a macro to do all that. Is the 'different location' and outlook or windows folder?
ND says
the different location is a windows folder location "D:/Program Files/Saved Emails
Diane Poremsky says
This does the saving - https://www.slipstick.com/developer/code-samples/save-selected-message-file/ - the last link at the bottom (to VBOffice.net) is a macro that saves all messages as they arrive. Do you need to open the message? if so, it might be better to open the copy on the hard drive instead of the one in the inbox, because it will be harder to mark it unread without marking all mail unread.
David Sivewright says
Thanks! Once again that worked perfectly!!
David Sivewright says
What am i Dim 'ing at the top of the page??
Diane Poremsky says
Oops, sorry. Try this:
Dim i as long
David Sivewright says
So this one is similar to my issue above, we have a vendor that sends dozens of invoices at a time, each e-mail contains one invoice, but all the invoices have the same name.. There for it prints the first e-mail's attachment times the number of e-mails w/ the same attachment name. Is there code similar to the one below that would fix this?
i = i + 1
sFile = sDirectory & i & oAtt.filename
Thanks!
Diane Poremsky says
incrementing the number doesn't work? Oh, it only counts on the current message. Dim it at the top of the page, outside of the macros and the count will be remembered as long as outlook is open and keep going up.
Also, you could try deleting the file after printing
I'm not sure if Kill works in Outlook-
Kill sFile
if not, use the filesystem object - do this after end select - or before end sub if you are only printing one file each time the macro runs.
dim fs as object
Set fs = CreateObject("Scripting.FileSystemObject")
fs.DeleteFile "c:junk.xls", force
set fs = nothing
Heather Coulter says
How can I get this code to print all of the pages
' 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 ".doc", ".docx", ".tif", ".gif", ".png", ".jpg"
'dtDate = oMail.SentOn
'sName = Format(dtDate, "hhnnss", vbUseSystemDayOfWeek, vbUseSystem)
'sFile = sDirectory & sName & oAtt.FileName
'oAtt.SaveAsFile sFile
'ShellExecute 0, "print", sFile, vbNullString, vbNullString, 0
Diane Poremsky says
it should print all of the pages - it uses the shell printer (the default printer and printer settings). Remove the ' from the beginning of each line so they are used.
Heather Coulter says
Sorry, I was only commented it out because it was not working properly.
Since the ".tif", ".gif", ".png", ".jpg" open using paint - it is only the first page. Is there some setting I am missing?
Diane Poremsky says
No, not that I know of. The application handles the printing - I have no idea why it wouldn't print all pages.
David Sivewright says
That worked Perfectly!! Thanks!
David Sivewright says
I will try this when i am back in the office tomorrow morning! Thanks for the quick response!!!
David Sivewright says
So i have come across an issue. When we receive an e-mail that has multiple PDF attachments all with the same name. This Macro will print the first PDF times the number of attachments in the e-mail. So for example there is an e-mail with 5 pdf attachments, i get 5 copies of the first attachment. Sorry please delete my previous post..
Diane Poremsky says
Try changing
sFile = sDirectory & oAtt.FileName
to
i = i + 1
sFile = sDirectory & i & oAtt.filename
that will increment the filename so its unique.
Brian says
Hi Diane,
I entered the Macro in ThisOutlookSeesion and nothing happened. When I hit F8 in the Application_Startup() it skips the following 2 lines:
Dim Ns As Outlook.NameSpace
Dim Folder As Outlook.MAPIFolder
What do I need to change?
Thanks.
Diane Poremsky says
Those two are skipped - they just tell VBA what those variables are for. You need to Run the application startup module so Outlook knows to watch for messages - it is normally triggered when you start Outlook but it's a PITA to keep restarting Outlook when you are testing it. :)
Angelooo says
Dear Diane,
I've got a problem with this macro. I'd like to let it work on another folder, not the Inbox.
Searching in the comments I found this code but it does not work and it replicates all mails in my inbox folder.
Set Folder = Ns.GetDefaultFolder(olFolderInbox).folders("folder-name")
My structure is Inbox - SubFolder - SubFolder - "ToPrint"
After it is printed he should move it to another folder
Inbox - SubFolder - SubFolder - "Printed"
How do I get it work?
Thanks
Diane Poremsky says
Because you are using nested folders, you should declare more variables and "walk" down the path.
This is the path you need:
Set Folder = Ns.GetDefaultFolder(olFolderInbox).folders("subfolder").folders("subfolder").folders("ToPrint")
Dim subFolder1 as Folder
Dim printFolder as Folder
Dim moveFolder as Folder
Set Folder = Ns.GetDefaultFolder(olFolderInbox).folders("subfolder")
Set subFolder1 = subFolder1.folders("subfolder")
Set printFolder = subFolder2.folders("ToPrint")
Set moveFolder = subFolder2.folders("Printed")
Set Items = printFolder.Items
After printing, you'd use
omail.move movefolder
Eugene Young says
Does this only work with MAPI? Will this work for IMAP or POP3?
Diane Poremsky says
It works with any account type.
Eugene Young says
Would I need to change the code to work with IMAP? I cannot get it to run and the only thing different I am doing using a IMAP account instead of MAPI.
Diane Poremsky says
Any error messages? The only reason it wouldn't work with IMAP is if you download only headers. The full messages needs to be downloaded.
muffitt says
hello, I would like to automatically print an attachment from a specific email that i receive. not for all. is this possible
Diane Poremsky says
You, you can use a run a script rule that looks for that person and calls a the script if its found. Or use the macro on this page and use the rule to move the message to a specific folder, which the macro is watching.
Brad Tighy says
Hi Diane. When I receive attachments on a mail I have to click on the html link which takes me to the web and then I download the zip attachment (unfortunately this is how I receive some attachments from clients). Is there anyway to print this automatically ?
Thanks Brad
Diane Poremsky says
So you need outlook to get the file, extract and print? What zip application do you use? It might be possible to automate it using a macro, if the zip program supports it. But it's not something built into Outlook's object model.
Brad Tighy says
Yes so I basically need it to open the link and then extract the file and print the pdf's in the zip. The zip application is WAR. How would I go about adding this in macro ?
Diane Poremsky says
First you need to find out if WAR supports command line unzip. If so, you can probably unzip it from VBA.
Mike says
It's in thisoutlooksession like you suggested above. I will try the other though. I will also try switching it to public. I did just remove the private word and it did indeed show up. I will try your suggestions though and post back. I appreciate you taking the time to answer me.
Mike says
Is there something I'm doing wrong? I can't get this to show up any way to run it. I know Private Subs don't come up in Macros, but I can't see this under rules either.
Diane Poremsky says
is it in a module or thisoutlooksession? Try it in the other...
Which macro are you using? It needs to be this one: Sub MovePrintedMail(oMail As Outlook.MailItem)
if you change private to public, can you see it in rules?
ruirebelorodrigues says
Diana,
Any suggestion on my question?
Diane Poremsky says
To send files to other printers you need to change the default windows printer. AFAIK, you'll need to loop the copies - you can't set the number of copies. Unfortunately, I don't have a code sample for changing the printer and I couldn't find one on the internet - I'm sure there is one somewhere out there, I just couldn't find it.
Dave says
Hi Diana
Excel attachemnts I often receive contain multiple sheet.
The script only prints the first page automatically.
Any ideas on how to print all or some of the sheets.
I don't know the name of the sheets being printed.
If I isolated the Excel files, would something like this work?
Dim sh as Worksheet
For Each sh In ActiveWorkbook.Worksheets
sh.PrintOut
Next sh
Diane Poremsky says
You'll need to bind the excel object model to use excel commands in an outlook macro - do that and the code looks like it should work.
Rui Manuel Rodrigues says
Hi Diana,
Great script!
I'm using your script to print multiple copies of a PDF attachement. The problem is that I need to print 1000 copies of a pdf. I need to print to 12 different network printer. The script is sending the file (6Mb) x 1000 copies x 12 printer over the network.
1) is there a way to specify the number of copies and not using a loop?
2) specify other than the default printer (actually my solution is to use a tool called 'Print Distributor')
Thx
tara says
yes a message box came up when i did that.
Have had no error messages.
Diane Poremsky says
That means the macro is being called. So the problem is somewhere within it.
tara says
Hi Diane,
cannot figure out what I am doing wrong, I have office 2007 so tried 32 and 64bit.
have enabled macros but still not working.
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).Folders("Invoices")
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 = "H:\Attachments\"
Set colAtts = oMail.Attachments
If colAtts.Count Then
For Each oAtt In colAtts
sFileType = LCase$(Right$(oAtt.FileName, 4))
Select Case sFileType
Case ".xls", ".doc"
sFile = ATTACHMENT_DIRECTORY & oAtt.FileName
oAtt.SaveAsFile sFile
ShellExecute 0, "print", sFile, vbNullString, vbNullString, 0
End Select
Next
End If
End Sub
Diane Poremsky says
No error messages? Click in the Startup macro and then click Run. Before PrintAttachments Item, add Msgbox item.subject and see if a message box comes up.
Diane Poremsky says
Re: 32 or 64 bit. Use the same version as your office build - for 2007, that is 32 bit.
Is this correct: Case ".xls", ".doc"
those extensions are used with older versions of office. New extensions are .xlsx and .docx - the file extension has to be exact. It covers 4 characters, so its either 3 and a period or 4 for the extension and no period.
Muktar says
Hi Diane,
nice micro, works perfect, Thank you
need little help on....
I get 2 pdf attachment in each email, one of the pdf i need 3 copes and the other one only one copy,
for example ( order_123_1234.pdf & 1234567890.pdf )
Thank you.
Diane Poremsky says
Which one do you need 3 copies of? As long as the file name format is the same everything (so you can filter on it), it won't be too hard to send it to the printer 3 times. If you use Acrobat, the number in the 3rd position is # of copies. AcroExchAVDoc.PrintPages(0, num, 3, 1, 1)
Torch says
Hello Diane,
That's Great!
The macro works perfectly.
Is there any way to choose the paper quality? like A4 or A3 and choose duplex options when print?
Thank you!
Diane Poremsky says
Generally speaking, no, outlook uses the default settings. I'm not sure if Acrobat supports choosing pager size, but if you print using word, you could - you can't use the windows print commands (which these macros do), you need to call Word and use it's print dialog. I can't find any samples right now - I don't have any and the sites that had samples are no longer working. :(
Adam says
Hello Diane,
Thank you for the excellent script. It works like a charm!
Is there any way to choose a different network printer than the default? Thank you in advance.
Diane Poremsky says
You'd need to use VB to change the printer then change it back. I don't have any code samples handy that work with current versions though.
Oscar says
Hi Diane
I have Outlook 2010 64 bit and can't get this Macro visible in my Macro list.
Do you have any ideas what could be the problem?
1. I hit ALT +F11 and copied the 64bit code inside ThisOutlookSession:
' Written by Michael Bauer, vboffice.net
' https://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 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 ".pdf", ".doc", "docx"
sFile = sDirectory & oAtt.FileName
oAtt.SaveAsFile sFile
ShellExecute 0, "print", sFile, vbNullString, vbNullString, 0
End Select
Next
End If
End Sub
2. I signed the macro, but nothing changed
3. when I change Private Sub Application_Startup() to Sub Application_Startup() the macro is visible in the macro list
Diane Poremsky says
Private subs are not listed in the Macro list - they are ones you can't invoke manually to do anything. In the case of the startup macro, its fired when outlook is first started. you can click in it in the VBeditor and press Run to kick start it during testing, but that is the only time you need to do that. Macros with names like this: Private Sub Items_ItemAdd(ByVal Item As Object) or this Private Sub PrintAttachments(oMail As Outlook.MailItem) are called by events, from other macros, or using the Rules actions 'run a script'. ItemAdd is triggered when an item is added to the folder the macro is watching. The PrintAttachments macro is called by the item add macro - it could also be used in a Run a Script rule.
Henry says
Hello Diane,
The print work perfectly but the printed mail don't move to the specific folder i pointed to.
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
Sub MovePrintedMail(oMail As Outlook.MailItem)
Dim objDestFolder As Outlook.MAPIFolder
Set objDestFolder = Session.Folders("Printed")._
Folders("Inbox").Folders("Printed")
oMail.Move objDestFolder
Set objDestFolder = Nothing
End Sub
I am using Outlook 2007. I've tried Joris Robijn or jrobijn or the folder name Printed(just under the inbox).I also tried this.
Set objDestFolder = GetFolderPath("JSOTOL ASAP\Inbox\Printed")
Still don't move the message, sometimes i get this error code 2147221233 (8004010f).
Please help me.
Thanks in advance.
Diane Poremsky says
Is the folder is a different data file? If it's under your inbox, you can use this format:
Set objDestFolder = Session.Folders("mailbox name").Folders("Inbox").Folders("Printed")
The mailbox name is the name as it appears in the folder list.
Hendry Tjonadi says
Thank you for your sincerely help Diane, I appreciate it. You made my day :)
Jos says
Hello,
To print pdf's, I need Acrobat pro (as mentioned above ), because acrobat reader doesn't support OLE.
Nevertheless I can use acrobat reader with the following code =>
strPath = "C:\Program Files (x86)\Adobe\Reader 11.0\Reader\AcroRd32.exe"
If Len(Dir(strPath)) > 0 Then
strPath = strPath & " /N /T " & Chr(34) & FullFile & Chr(34)
Retval = Shell(strPath, vbMinimizedNoFocus)
End If
It works fine for me and I don't need Acrobat pro for this.to print pdf's
Gustavo says
could you kindly advise where to place the code used to print by using Adobe Reader. Thank you.
Diane Poremsky says
Windows will use the default program assigned to PDFs to print.
Joeri van Woudenberg says
Dear Diane, i still cant get it to work with the basic code.. i need to print all incoming attachments(faxes as PDF) to our default printer. I cant figure out why its all failing and its not printing at all.. I just over copyed the code above for attachments and adjusted the save location. Can you help me out?
Diane Poremsky says
Do you get any error messages? Did you set macro security to low? This line nees to be changed:
' Add additional file types below
Case ".xls", ".doc", "docx"
to this, if you only want to print pdf.
' Add additional file types below
Case ".pdf"
Andy says
I'm also having a problem with moving the email after printing, I get the error "Folders - Sub or function not defined"
Diane Poremsky says
Does it highlight a line? If so, paste that line here - it sounds like it is malformed.
Chris says
Hi Diane,
The code works great - thank you!!
One question: Is there a way to clean up the "Attachment" directory after each print job?
Thanks again!
Regards
Diane Poremsky says
The easiest might be to use windows scripting after they are printed -
Dim objFSO As Object
Set objFSO= CreateObject("Scripting.FileSystemObject")
Use this at the very end to delete everything in the folder
objFSO.DeleteFile("D:\Attachments\*.*")
or this after each print routine to delete the last item printed.
objFSO.DeleteFile(sFile)
I'm not sure if the print routine will be finished with the attachment fast enough, so deleting all at the end might be best.
ETA - in thinking about it more, the delete all method (and error checking so the routine skips files still in use) would be method - anything that gets missed because it was still being printed will be deleted the next time the macro runs.
Mike says
here is the code I used and it prints great, but don't move the email to the folder as I need it to!
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
MovePrintedMail 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 = "T:\Attachments\"
Set colAtts = oMail.Attachments
If colAtts.Count Then
For Each oAtt In colAtts
sFileType = LCase$(Right$(oAtt.FileName, 4))
Select Case sFileType
Case ".pdf"
sFile = ATTACHMENT_DIRECTORY & oAtt.FileName
oAtt.SaveAsFile sFile
ShellExecute 0, "print", sFile, vbNullString, vbNullString, 0
End Select
Next
End If
End Sub
Sub MovePrintedMail(oMail As Outlook.MailItem)
Dim objDestFolder As Outlook.MAPIFolder
Set objDestFolder = Session.Folders("JSOTOL ASAP"). _
Folders("Inbox").Folders("Printed")
oMail.Move objDestFolder
Set objDestFolder = Nothing
End Sub
any idea where the code is wrong? I have tried with the email address and the inbox name and nothing...
Diane Poremsky says
The code assumes the folder is in your default mailbox, if not you need to use the GetFolderPath function and format it like this:
Set objDestFolder = GetFolderPath("JSOTOL ASAP\Inbox\Printed")
You'll use the mailbox name as displayed in the folder list.
Atul says
Thank you Diane,
This worked perfect. Thanks for your prompt help.
Atul says
Diane,
This is nothing short of a miracle. I am not finding the right words to to thank you for this master piece.
I have made a little change to this and established a process to move the emails that I want to print attachments from, to a new folder under Inbox. I works perfect. However there is a situation in which it does not work correctly. I receive multiple emails from the same email address on same date and at same time. The attachments in each email are different scan images however they all have same name "document.pdf". When I move a batch of emails containing attachment with same name, only one document gets printed multiple times. I tried to sort them on date, time etc but still got the same result. The work around I found is to transfer one email at a time to the folder for printing.
I there any tweek in the code that you could suggest, which would resolve this problem?
Thanks for your help!
Diane Poremsky says
outlook gets confused because the file names are the same. You could try changing this line:
sFile = sDirectory & oAtt.FileName
to
' add to top of macro with other dim's
Dim dtDate As Date
Dim sName As String
dtDate = oMail.SentOn
sName = Format(dtDate, "hhnnss", vbUseSystemDayOfWeek, vbUseSystem)
sFile = sDirectory & sName & oAtt.FileName
The sent time for each message should vary by a second or more and this will give each file a unique name (hopefully!) and solve the problem.
Arjen says
Hi there, tnx for the macro, working like a charm. I'm just wondering, is there any way to move the email to an different folder, say "allready printed", after the mail has been printed out?
Tnx!
Diane Poremsky says
Yes, you can do that. You can either add it to the item add macro, after the print statement, or use a second macro and call it.
Add this to the ItemAdd macro, after the printattachments line:
MovePrintedMail Item
And add this after the printattachments macro - it assumes the folder is under the inbox.
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
Jason says
That worked, but FYI, senderemailaddress does not return a traditional e-mail address if the address is from a MS Exchange server, it prints out the entire path from Active Directory.
Diane Poremsky says
Correct, the SMTP address is not returned when using Exchange - the SenderName field will get the display name, which is generally better. It would also be possible to use regex to get the account alias from the x500 address.
Jason says
I'm curious if it's possible to add a parameter that the macro will not run unless it's from a certain sender address. How would one go about doing this?
Diane Poremsky says
Yes, you'd add an If... then statement.
something like this:
If colAtts.Count and if oMail.senderemailaddress = "alias@domain.com" then
For Each oAtt In colAtts
...
kelvin says
i tried this code and it's giving me an:
compile error:
only valid in object module
message... any advice?
Diane Poremsky says
Where did you put the code? This needs to be in ThisOutlookSession. (I messed up the instructions I added yesterday, sorry. I'll fix that nexr.)
kelvin says
ah.. there we go!!! thanks!\
ruyrazn says
Hello All,
I have the code copied into mysessionoutlook, but I am lost on what to do after that.
Could someone highlight any changes that I need to make to reflect my system folders I'm not sure what to do.
Diane Poremsky says
Change the folder path ( sDirectory = "D:\Attachments\" ) so it uses a path on your system (files need saved to print) and add file types if needed to Case ".xls", ".doc", "docx". Then click in the Application_Startup() macro and press Run button (F8). This starts the macro without the need to restart Outlook. Send yourself some mail with attachments in the Case list and they will be printed on arrival.
Leo says
Seems like 2010 I get an 'Object could not be found' error when trying to drill down to multiple folders. the script works fine on 2003 =(
Diane Poremsky says
What code are you using for multiple folders? It should work in both versions, the only exception being the change to support 64bit Outlook.
Michael Senra says
Thanks! Works beautifully. Now, the only other question I have is whether I can make it also just print a copy of the actual email itself afterwords; sort of like a 'cover'. The premise is that my client gets a lot of overnight orders, and it's becoming a hassle to spend the first hour in the morning just printing these emails out.
I know I can just make a rule that will print it out, but there's no way of making sure that the script runs first, or last, AFAIK depending on there needs. If I could just get it built into the script, it would make things a whole lot simpler!
Do you know if this is possible?
Diane Poremsky says
Yes, it's possible. You'll .PrintOut to do it. Try adding it after the attachments print -
Private Sub Items_ItemAdd(ByVal Item As Object)
If TypeOf Item Is Outlook.MailItem Then
PrintAttachments Item
item.printout
End If
End Sub
You could add it at the end to the printattachments macro - using omail.printout
Michael Senra says
How would I go about printing multiple copies, like I wanted to print 2 copies of the attachment?
Diane Poremsky says
You'd need to use a loop. If you always wanted to print 2, you'd use something like i = 1 to 2 then next i at the end. If you wanted to pick each time, use a variable - i = 1 to x and use an inputbox to get the value of x. If you are printing more than 20, I'm told this is not the best way to handle it.
for i = 1 to 2
ShellExecute 0, "print", sFile, vbNullString, vbNullString, 0
next i
if you are always printing a specific document type, there may be other, better ways to do it.
Nancy says
Is there a way to use this to only print the 2nd page of an attachment? We are switching to Fax2Mail and every document will have a cover sheet included that we don't want to print.
Diane Poremsky says
I'm checking on it, but AFAIK, no. Are the attachments PDF? What application is used to print them?
Ignacio Garcia says
The code works very well for outlook. do you have something that can work for google mail?
Diane Poremsky says
In the browser? No. I don't see anything in google labs - https://mail.google.com/mail/u/0/?shva=1#settings/labs - I didn't check in the firefox addons to see if there is anything there, but that could be another option.
Bill Hall says
Hi Diane P. I added this code per instructions above and nothing is happening is a UNC path a calid path for the save?
Diane Poremsky says
it should work. Press f8 to step through the code and see if it skips any lines. You can also click in the margin to set a breakpoint - the code will stop if it hits the line where a breakpoint is set. This will help you to see where its failing. You can also hover over the variables in the code and see if its using the correct file path.
Debbie says
This looks great. I only want to print attachments from a specific folder. Or I would be happy with a macro that I select the message and then hit the macro to print it's attachment. Has anyone modified this macro for either of these 2 options?
Diane Poremsky says
To print only new messages in a specific folder, you would change
Set Folder = Ns.GetDefaultFolder(olFolderInbox)
If the folder is a subfolder of the inbox, it would be
Set Folder = Ns.GetDefaultFolder(olFolderInbox).folders("folder-name")
Changing it to work on a selected message would take a few more changes, but is do able.
Anthony says
After changing the default photo application to paint,it works now!Tks for help :)
Anthony says
I have a qusetion about printing .tif.
When attachment file is .tif or .tiff，it can't print silently and will show a printing wizrd,how can I avoid it?I wanna print it automatically,thanks for reply.
Diane Poremsky says
You're getting the photo printing wizard. I hate that thing. :) You need to change the default photo application. See Turn Off the Print Picture Wizard when Printing Attachments for details.
Matt says
I am curious to how you could convert this macro to include the automatic printing of image attachments as well. Otherwise this just opens an image attachment in Picture and Fax Viewer.