Excel VBA, “Print” secured pdf to another pdf file using Shell

问题

I have searched inside a folder in outlook, found all emails with a defined title, and downloaded their attachments into a folder via Excel VBA.

I now need to print those to new pdfs via Adobe Reader XI through VBA - as they are password protected- to be able to convert to RFT (I use VBA to get data from the PDF converted to RFT).

Somehow the correct RF layout is only created if the already saved pdf file is printed to a secondary pdf- Saving doesn't work - whether by explorer pdf viewer, Nitro or Adobe makes no difference.

I have tried Attachment.Printout but get error that the object does not support, am not able to find the option within a Shellexecute that will allow printing to file, as the main advice online allows printing via:

 Call apiShellExecute(Application.hwnd, "print", strPathAndFilename, vbNullString, vbNullString, 0)

with options /p and /h for printing. any help on how to accomplish this with or without shell (or directly convert secured pdf to rft is appreciated). The code I use ( borrowed and edited from VBA to loop through email attachments and save based on given criteria) for automatically downloading the files is listed bellow:

Sub email234()

Application.ScreenUpdating = False

    Dim sPSFileName As String
    Dim sPDFFileName As String
    Dim olApp As Object
    Dim ns As Namespace

    Set olApp = CreateObject("Outlook.Application")
    Set ns = olApp.GetNamespace("MAPI")
    Dim oItem As Object
    Dim olMailItem As Outlook.MailItem


   Dim olNameSpace As Object
   Dim olFolder As Object
   Dim olFolderName As String
   Dim olAtt As Outlook.Attachments
   Dim strName As String
   Dim sPath As String
   Dim i As Long
   Dim j As Integer
   Dim olSubject As String
   Dim olSender As String
   Dim sh As Worksheet
   Dim LastRow As Integer

olFolderName = "\\Subscriptions\Inbox" 'ThisWorkbook.Worksheets("Control").Range("D10")
olSender = "Argus Alerts" 'ThisWorkbook.Worksheets("Control").Range("D16")

sPath = Application.FileDialog(msoFileDialogFolderPicker).Show
sPathstr = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)

Set olNameSpace = olApp.GetNamespace("MAPI")

'check if folder is subfolder or not and choose olFolder accordingly
    Set olFolder = ns.Folders("Subscriptions").Folders("Inbox")
   strName = "Argus Ammonia"

h = 2
For i = 1 To olFolder.Items.Count

    If olFolder.Items(i).Class <> olMail Then
    Else
        Set olMailItem = olFolder.Items(i)

        'check if the search name is in the email subject
        'If (InStr(1, olMailItem.Subject, olSubject, vbTextCompare) <> 0) Then
        If (InStr(1, olMailItem.Sender, olSender, vbTextCompare) <> 0) Then

            With olMailItem
                For j = 1 To .Attachments.Count
                    strName = .Attachments.Item(j).DisplayName

                    'check if file already exists
                    If Not Dir(sPathstr & "\" & strName) = vbNullString Then
                         strName = "(1)" & strName
                    Else
                    End If

                    If Err.Number <> 0 Then
                    Else
                        .Attachments(j).SaveAsFile sPathstr & "\" & strName

                    End If
                    Err.Clear
                    Set sh = Nothing
                    'wB.Close
                    On Error GoTo 0

                    h = h + 1
                Next j

            End With

        End If
    End If
Next i


Application.ScreenUpdating = True
MsgBox "Download complete!", vbInformation + vbOKOnly, "Done"

End Sub

回答1:

You can hard code the path to your EXE, please refer to the below code:

   Declare Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" _
   (ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult As String) As Long

   Sub Test_Printpdf()
    Dim fn$
    fn = "C:\Users\Ken\Dropbox\Excel\pdf\p1.pdf"
    PrintPDf fn
   End Sub

Sub PrintPDf(fn$)
  Dim pdfEXE$, q$

  pdfEXE = ExePath(fn)
  If pdfEXE = "" Then
    MsgBox "No path found to pdf's associated EXE.", vbCritical, "Macro Ending"
    Exit Sub
  End If

  q = """"
  'http://help.adobe.com/livedocs/acrobat_sdk/10/Acrobat10_HTMLHelp/wwhelp/wwhimpl/common/html/wwhelp.htm?context=Acrobat10_SDK_HTMLHelp&file=DevFAQ_UnderstandingSDK.22.31.html
  '/s/o/h/p/t
  Shell q & pdfEXE & q & " /s /o /h /t " & q & fn & q, vbHide
End Sub

Function ExePath(lpFile As String) As String
   Dim lpDirectory As String, sExePath As String, rc As Long
   lpDirectory = "\"
   sExePath = Space(255)
   rc = FindExecutable(lpFile, lpDirectory, sExePath)
   sExePath = Left$(sExePath, InStr(sExePath, Chr$(0)) - 1)
  ExePath = sExePath
End Function

Sub Test_ExePath()
   MsgBox ExePath(ThisWorkbook.FullName)
End Sub

Added an API method to find the path, the command line parameters don't work as well with the newer Adobe Acrobat Reader DC.

For more information, please refer to these links:

Printing a file using VBA code

Print a PDF file using VBA

来源：https://stackoverflow.com/questions/53578953/excel-vba-print-secured-pdf-to-another-pdf-file-using-shell