Excel VBA，“打印”使用Shell将pdf保护为另一个pdf文件

我在outlook中的一个文件夹中搜索，找到所有带有已定义 Headers 的电子邮件，并通过Excel VBA将其附件下载到文件夹中 .

我现在需要通过Adobe Reader XI通过VBA将这些打印到新的PDF文件 - 因为它们受密码保护 - 能够转换为RFT（我使用VBA将PDF中的数据转换为RFT） .

不知何故，正确的RF布局只有在已经保存的pdf文件打印到辅助pdf- Saving doesn't work 时才会创建 - 无论是通过浏览器pdf查看器，Nitro还是Adobe都没有区别 .

我已经尝试了Attachment.Printout但是得到了对象不支持的错误，我无法在 Shellexecute 中找到允许打印到文件的选项，因为在线的主要建议允许通过以下方式打印：

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

使用选项 /p 和 /h 进行打印 . 任何有关如何使用或不使用shell（或直接将安全的pdf转换为rft）的帮助表示赞赏 . 我使用的代码（借用和编辑自VBA to loop through email attachments and save based on given criteria）自动下载文件如下：

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