2
votes

I'm putting together some VBA in Outlook to send PDF attachments from an Outlook folder to a folder in C:\Temp\ and then print them to the default printer.

Issue is, this is opening the Acrobat Reader to the "Recent" file list and not actually sending anything to the default printer.

My current code:

Option Explicit
Public Sub PrintAttachments()
Dim Inbox As MAPIFolder, Item As MailItem, Atmt As Attachment, FileName As String, i As Integer, Path As String

Set Inbox = Outlook.Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("Batch Prints")

For Each Item In Inbox.Items
    For Each Atmt In Item.Attachments

    Path = "C:\Temp\Batch Prints\"
    If Len(Dir(Path, vbDirectory)) = 0 Then MkDir Path
        FileName = Path & Atmt.FileName
        Atmt.SaveAsFile FileName

        Call PrintPdf(FileName)

    Next
Next

Set Inbox = Nothing
End Sub

Public Sub PrintPdf(Filepath As String)
    Shell "C:\Program Files (x86)\Adobe\Acrobat Reader 2017\Reader\AcroRd32.exe /p /h " & Chr(34) & Filepath & Chr(34), vbHide
End Sub

No error occurs, and stepping through the code doesn't hint at any issues, but the Acrobat Reader app will open rather than print.

enter image description here

Is there something obvious that I am missing to have these files actually sent to the default printer?

Thank you!

1

1 Answers

0
votes

Try Specify privileged locations for trusted content setting for PDFs

  1. Select Preferences > Security (Enhanced).
  2. Select the Enable Enhanced Security option.
  3. Specify a list of locations in the Privileged Locations section, and then click OK.

ShellExecuteA function MSDN


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

Public Sub PrintAttachments()
    Dim Inbox As MAPIFolder
    Dim Item As MailItem
    Dim Atmt As Attachment
    Dim FileName As String
    Dim i As Integer
    Dim Path As String

    Set Inbox = Outlook.Application.GetNamespace( _
                            "MAPI").GetDefaultFolder( _
                               olFolderInbox).Folders("Batch Prints")

    For Each Item In Inbox.Items
        DoEvents
        For Each Atmt In Item.Attachments
        DoEvents

        Path = "C:\Temp\Batch Prints\"

        If Len(Dir(Path, vbDirectory)) = 0 Then MkDir Path
            FileName = Path & Atmt.FileName
            Atmt.SaveAsFile FileName

            ShellExecute 0, "print", FileName, vbNullString, vbNullString, 0

        Next
    Next

    Set Inbox = Nothing
End Sub