[英]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. 我已经在Outlook中的文件夹中进行搜索,找到了所有具有定义标题的电子邮件,并通过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). 现在,我需要通过VBA通过Adobe Reader XI将这些文件打印到新的pdf文件(因为它们受密码保护)才能转换为RFT(我使用VBA从转换为RFT的PDF中获取数据)。
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. 不知何故,只有在将已保存的pdf文件打印到第二个pdf时,才能创建正确的RF布局- 保存不起作用 -无论是通过Explorer pdf查看器,Nitro还是Adobe都没有影响。
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: 我尝试了Attachment.Printout,但收到对象不支持的错误,无法在Shellexecute
中找到允许打印到文件的选项,因为在线主要建议允许通过以下方式进行打印:
Call apiShellExecute(Application.hwnd, "print", strPathAndFilename, vbNullString, vbNullString, 0)
with options /p
and /h
for printing. 带有选项/p
和/h
进行打印。 any help on how to accomplish this with or without shell (or directly convert secured pdf to rft is appreciated). 任何有或没有外壳的帮助(或将受保护的pdf直接转换为rft的方法)都将得到帮助。 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: 下面列出了我使用的用于自动下载文件的代码(从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
You can hard code the path to your EXE, please refer to the below code: 您可以对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
Added an API method to find the path, the command line parameters don't work as well with the newer Adobe Acrobat Reader DC. 添加了一个API方法来查找路径,命令行参数在更新的Adobe Acrobat Reader DC中不起作用。
For more information, please refer to these links: 有关更多信息,请参考以下链接:
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.