Outlook 2016 to print attachments automatically


New Member
Apr 18, 2019

I have the following code written up for me but I cant seem to get this to work.
I have Outlook 2016 64 bit, i require all my invoices to be printed either as they come in or late in the afternoon (4:30pm)
I have a rule that will move these invoices to the invoice folder and run the following script, but this script doesnt seem to work.
No error messages come up and nothing prints out, When I run the test print that works but it chooses a random invoice from a couple of months ago.


Option ExplicitPublic 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 Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub TestPrint()
Dim olMsg As MailItem
    On Error Resume Next
    Set olMsg = ActiveExplorer.Selection.Item(1)
    PrintAttachment olMsg
    Exit Sub
End Sub

Sub PrintAttachment(olItem As MailItem)
'Graham Mayor - https://www.gmayor.com - Last updated - 10 Jul 2019
Dim olAttach As Attachment
Dim strFName As String
Dim strExt As String
Dim j As Long
Dim fso As Object, TmpFolder As Object
Dim tmpPath As String

    'Get the user's TempFolder to store the temporary file
    Set fso = CreateObject("Scripting.FileSystemObject")
    tmpPath = fso.GetSpecialFolder(2) & "\"
    On Error GoTo lbl_Exit
    If olItem.Attachments.Count > 0 Then
        For j = 1 To olItem.Attachments.Count
            Set olAttach = olItem.Attachments(j)
            If olAttach.FileName Like "*.pdf" Then
                strFName = olAttach.FileName
                olAttach.SaveAsFile tmpPath & strFName
                NewShell tmpPath & strFName, 3
                Sleep 2000
                Kill tmpPath & strFName
            End If
        Next j
    End If
    Set olAttach = Nothing
    Set olItem = Nothing
    Exit Sub
End Sub

Public Sub NewShell(cmdLine As String, lngWindowHndl As Long)
    ShellExecute lngWindowHndl, "Print", cmdLine, "", "", 1
    Exit Sub
End Sub

Some videos you may like

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.


MrExcel MVP
Oct 15, 2007
Comment out the two On Error statements and see if any errors occur.

Watch MrExcel Video

Forum statistics

Latest member

This Week's Hot Topics

  • Finding issue in If elseif else with For each Loop
    Finding issue in If elseif else with For each Loop I have tried this below code but i'm getting in Y column filled with W005. Colud you please...
  • MsgBox Error
    Hi Guys, I have the below error show up when i try and run my macro in File1 but works fine if i copy and paste the same code into file2. [ATTACH...
    My Cell Format is [B]""0.00" Cr". [/B]But in the cell, it is showing 123.00 for editing. (123 is entry figure). (Data imported from other...
  • Show numbers nearly the same
    Is this possible. I have a number that can change very time eg 0.00001234 Then I have a lot of numbers 0.0000001, 0.0000002, 0.00000004...
  • Please i need your help to create formula
    I need a formula in cell B8 to do this >>if b1=1 then multiply ( cell b8) by 10% ,if b1=2 multiply by 20%,if=3 multiply by 30%. Thank you in...
  • Got error while adding column and filter
    Got error while adding column and filter In column Z has some like "Success" and "Error". I want to add column in AA if the Z cell value is...