Microsoft Office Forums - View Single Post - Automatic Attachment Script for Outlook 16 64 bit

gmayor · 07-09-2019, 10:18 PM

Run the following script (PrintAttachment) from the rule that moves the invoices. It should work in the 64 bit version of Outlook though I cannot test it here.

You may have to extend the sleep period if your PC is slow to save and open the PDFs.

I have included a text macro so that you can test the process on a message with a PDF attachment.

Code:

Option Explicit
Public 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