Outlook 2016 to print attachments automatically

Thomo4321

New Member
Joined
Apr 18, 2019
Messages
44
Office Version
  1. 2016
Platform
  1. Windows
Morning,

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.

Thanks

Code:
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
lbl_Exit:
    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
lbl_Exit:
    Set olAttach = Nothing
    Set olItem = Nothing
    Exit Sub
End Sub


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

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.

Forum statistics

Threads
1,213,554
Messages
6,114,280
Members
448,562
Latest member
Flashbond

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top