Excel VBA, «Печать» защищенного PDF в другой файл PDF с помощью Shell

Question

Я искал в папке в outlook, нашел все электронные письма с определенным заголовком и загрузил их вложения в папку через Excel VBA.

Теперь мне нужно распечатать их в новые PDF-файлы через Adobe Reader XI через VBA - поскольку они защищены паролем - чтобы иметь возможность конвертировать в RFT (я использую VBA для получения данных из PDF, конвертированных в RFT).

Каким-то образом правильный макет RF создается только в том случае, если уже сохраненный PDF-файл распечатывается на вторичный PDF- Сохранение не работает - независимо от того, просматривает ли PDF Explorer исследователь, 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

Печатьфайл PDF с использованием VBA