Excel VBA，使用命令行管理程序將“ Print”保護的pdf轉換為另一個pdf文件

Question

我已經在Outlook中的文件夾中進行搜索，找到了所有具有定義標題的電子郵件，並通過Excel VBA將其附件下載到了文件夾中。

現在，我需要通過VBA通過Adobe Reader XI將這些文件打印到新的pdf文件（因為它們受密碼保護）才能轉換為RFT（我使用VBA從轉換為RFT的PDF中獲取數據）。

不知何故，只有在將已保存的pdf文件打印到第二個pdf時，才能創建正確的RF布局- 保存不起作用 -無論是通過Explorer pdf查看器，Nitro還是Adobe都沒有影響。

我嘗試了Attachment.Printout，但收到對象不支持的錯誤，無法在Shellexecute中找到允許打印到文件的選項，因為在線主要建議允許通過以下方式進行打印：

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

帶有選項/p和/h進行打印。 任何有或沒有外殼的幫助（或將受保護的pdf直接轉換為rft的方法）都將得到幫助。 下面列出了我使用的用於自動下載文件的代碼（從VBA借用和編輯以遍歷電子郵件附件並根據給定的標准進行保存 ）：

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

Answer 1

您可以對EXE的路徑進行硬編碼，請參考以下代碼：

   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

添加了一個API方法來查找路徑，命令行參數在更新的Adobe Acrobat Reader DC中不起作用。

有關更多信息，請參考以下鏈接：

使用VBA代碼打印文件

使用VBA打印PDF文件