Last reviewed on September 30, 2014   —  153 Comments

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/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
' http://www.vboffice.net/en/developers/print-attachments-automatically
 
' use  Declare PtrSafe Function with 64-bit Outlook
Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias _
  "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
  ByVal lpFile As String, ByVal lpParameters As String, _
  ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long


Private Sub PrintAttachmentsSelectedMsg()
 Dim oMail As Outlook.MailItem
 Dim obj As Object
 'On Error Resume Next
 
For Each obj In ActiveExplorer.Selection
Set oMail = obj
 
  Dim colAtts As Outlook.Attachments
  Dim oAtt As Outlook.Attachment
  Dim sFile As String
  Dim sDirectory As String
  Dim sFileType As String
 
  sDirectory = "C:\Users\Diane\Docs\"
 
  Set colAtts = oMail.Attachments
 
  If colAtts.Count Then
    For Each oAtt In colAtts
 
' This code looks at the last 4 characters in a filename
      sFileType = LCase$(Right$(oAtt.filename, 4))
 
      Select Case sFileType
 
' Add additional file types below
      Case ".xls", ".doc", "docx"
 
        sFile = sDirectory & oAtt.filename
        oAtt.SaveAsFile sFile
        ShellExecute 0, "print", sFile, vbNullString, vbNullString, 0
      End Select
    Next
  End If
  
Next
End Sub

 

Use Acrobat's Printer Options

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

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

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

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

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


      Select Case sFileType

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


      End Select

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


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

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

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

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

     Set AcroExchPDDoc = AcroExchAVDoc.GetPDDoc

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

     If PrintMode = "All" Then

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

End Sub

Run a script version

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

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

Private Declare Function ShellExecute Lib "shell32.dll" Alias _
  "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
  ByVal lpFile As String, ByVal lpParameters As String, _
  ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
 
  
 Sub PrintAttachments(oMail As Outlook.MailItem)
  Dim colAtts As Outlook.Attachments
  Dim oAtt As Outlook.Attachment
  Dim sFile As String
  Dim sDirectory As String
  Dim sFileType As String
 
  sDirectory = "C:\Users\Diane\Documents\Attach\"
 
  Set colAtts = oMail.Attachments
 
  If colAtts.Count Then
    For Each oAtt In colAtts
 
' This code looks at the last 4 characters in a filename
      sFileType = LCase$(Right$(oAtt.FileName, 4))
 
      Select Case sFileType
 
' Add additional file types below
      Case ".pdf", ".doc", "docx"
 
        sFile = sDirectory & oAtt.FileName
        oAtt.SaveAsFile sFile
        ShellExecute 0, "print", sFile, vbNullString, vbNullString, 0
      End Select
    Next
    
  End If
     oMail.Delete
 

End Sub

How to use macros

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

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

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

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

To use the macro code in ThisOutlookSession:

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

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


Comments

  1. 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.

  2. 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.

  3. 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.

  4. 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.

  5. 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?

    • 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.

  6. 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

  7. 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.

  8. 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.

  9. 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
      ...

  10. 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.

  11. 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

  12. 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.

  13. 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.

  14. 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.

  15. Andy says

    I'm also having a problem with moving the email after printing, I get the error "Folders - Sub or function not defined"

  16. 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"

  17. 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.

  18. 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.

  19. 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
    ' http://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.

  20. 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.

  21. 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. :(

  22. 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)

  23. 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.

  24. 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

  25. 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.

    • 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.

  26. 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?

  27. 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.

  28. 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.

  29. 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.

    • 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.

  30. 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

  31. 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. :)

  32. 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.

  33. 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.

  34. 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

  35. 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:

    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

    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

  36. 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 :)

  37. 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.

  38. 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!

  39. 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

  40. 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.

  41. 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

  42. 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
    ' http://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 PoremskyDiane 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.

  43. 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?

  44. 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?

    • Webmaster says

      I have no idea what happened to the database, but the comments should be working again now. Thanks again for alerting me.

  45. 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
    ' http://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 PoremskyDiane 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 PoremskyDiane 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")

  46. 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 PoremskyDiane 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.

  47. 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 PoremskyDiane 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

  48. 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 PoremskyDiane Poremsky says

      converting to a different file type is would be more difficult unless irfan view can do it via command line.

    • Diane PoremskyDiane 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.

  49. 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?

Leave a Reply

Please post long or more complicated questions at OutlookForums by Slipstick.com.

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