Excel VBA,“打印”使用Shell将pdf保护到另一个pdf文件 [英] Excel VBA, "Print" secured pdf to another pdf file using Shell
问题描述
我已经在Outlook中的一个文件夹内进行搜索,找到了所有具有定义标题的电子邮件,并通过Excel VBA将其附件下载到了一个文件夹中。
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.
我现在需要通过VBA通过Adobe Reader XI将这些文件打印到新的pdf文件中-因为它们受到密码保护-才能转换为RFT(我使用VBA来获取将PDF中的数据转换为RFT)。
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).
只有在将已保存的pdf文件打印到第二个pdf时,才可以创建正确的RF布局-保存不起作用-是否通过浏览器pdf查看器,Nitro或Adobe都没有区别。
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.
我尝试了Attachment.Printout,但收到对象不支持的错误,无法在 Shellexecute $中找到该选项。 c $ c>将允许打印到文件,因为在线的主要建议允许通过以下方式打印:
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)
,带选项 / p
和 / h
进行打印。任何有或没有外壳的帮助(或将受保护的pdf直接转换为rft的方法)都将得到帮助。
我使用的代码(从),以自动下载文件:
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
推荐答案
您可以对EXE的路径进行硬编码,请参考以下代码:
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
添加了用于查找路径的API方法,命令行参数在较新的Adobe Acrobat Reader DC中无法正常运行。
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:
这篇关于Excel VBA,“打印”使用Shell将pdf保护到另一个pdf文件的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!