Outlook 2016 to print attachments automatically

Thomo4321

New Member
Joined
Apr 18, 2019
Messages
16
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
 

Some videos you may like

Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.

John_w

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

Watch MrExcel Video

Forum statistics

Threads
1,102,460
Messages
5,487,019
Members
407,575
Latest member
calc

This Week's Hot Topics

Top