如何将对象“生成的PDF文件”传递给另一个过程？这就是我所拥有的：
Sub CreateEncryptedPDF()
Dim sUserPass As String
Dim sMasterPass As String
Dim RandomString As String
Dim EncryptionString As String
Dim mastersheet As Worksheet
Set mastersheet = Workbooks(mastersheetfilename).Worksheets("Setting")
Dim checkIsTestEnvironmentSet As Variant
checkIsTestEnvironmentSet = Environ$("TestRun")
EncryptionString = CreateRandomString(RandomString)
If RandomString <> "" Then
sUserPass = Environ$("sUserPass")
sMasterPass = RandomString
Dim fdatum As String
fdatum = Format(Now - 1, "YYYYMMDD") 'Datum für Filename
'the area to be printed to PDF
mastersheet.Visible = xlSheetHidden
PrintToPDFCreator mastersheet.Range("B18") & "_" & fdatum & ".pdf", mastersheet.Range("B17"), Workbooks(mastersheetfilename), sMasterPass, sUserPass, True, True, True, True, True
sMasterPass = ""
sUserPass = ""
RandomString = ""
mastersheet.Visible = xlSheetVisible
Else
MsgBox "Sorry, es ist ein Problem beim Setzen des Owner-Passwortes aufgetreten (String Empty oder null)"
End If
End Sub
Sub PrintToPDFCreator(sPDFName As String, _
sPDFPath As String, _
xlBook As Workbook, _
Optional sMasterPass As String, _
Optional sUserPass As String, _
Optional bNoCopy As Boolean, _
Optional bNoPrint As Boolean, _
Optional bNoEdit As Boolean, _
Optional bEditComments As Boolean, _
Optional bFillForms As Boolean)
Dim pdfjob As Object
Dim sPrinter As String
Dim sDefaultPrinter As String
Dim iCopy As Integer, iPrint As Integer, iEdit As Integer, iEditComments As Integer, iFillForms As Integer
Dim mastersheet As Worksheet
Set mastersheet = Workbooks(mastersheetfilename).Worksheets("Setting")
sPDFPath = mastersheet.Range("B17")
fdatum = Format(Now - 1, "YYYYMMDD")
sPDFName = mastersheet.Range("B18") & "_" & fdatum & ".pdf"
If bNoCopy Then iCopy = 1 Else iCopy = 0
If bNoPrint Then iPrint = 1 Else iPrint = 0
If bNoEdit Then iEdit = 1 Else iEdit = 0
If bEditComments Then iEditComments = 1 Else iEditComments = 0
If bFillForms Then bFillForms = 1 Else iFillForms = 0
sDefaultPrinter = Application.ActivePrinter ' store default printer
sPrinter = GetPrinterFullName("PDFCreator")
If sPrinter = vbNullString Then ' no match
MsgBox "PDFCreator Not Available"
GoTo lbl_Exit
Else
Application.ActivePrinter = sPrinter
Set pdfjob = CreateObject("PDFCreator.clsPDFCreator")
With pdfjob
If .cStart("/NoProcessingAtStartup") = False Then
GoTo err_handler
End If
.cStart "/NoProcessingAtStartup"
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = sPDFPath
.cOption("AutosaveFilename") = sPDFName
.cOption("AutosaveFormat") = 0 ' 0 = PDF
If Not sMasterPass = vbNullString Then
'The following are required to set security of any kind
.cOption("PDFUseSecurity") = 1
.cOption("PDFOwnerPass") = 1
.cOption("PDFOwnerPasswordString") = sMasterPass
'To set individual security options
.cOption("PDFDisallowCopy") = iCopy
.cOption("PDFDisallowModifyContents") = iEdit
'.cOption("PDFDisallowPrinting") = iPrint
.cOption("PDFDisallowPrint") = iPrint
.cOption("PDFDisallowModifyComments") = iEditComments
.cOption("PDFAllowFillIn") = iFillForms
'To force a user to enter a password before opening
.cOption("PDFUserPass") = 1
.cOption("PDFUserPasswordString") = sUserPass
'To change to High encryption
.cOption("PDFHighEncryption") = 1
End If
.cClearCache
End With
'Print the workbook to PDF
xlBook.PrintOut
'Wait until the print job has entered the print queue
Do Until pdfjob.cCountOfPrintjobs = 1
DoEvents
Loop
pdfjob.cPrinterStop = False
'Wait until PDF creator is finished then release the objects
Do Until pdfjob.cCountOfPrintjobs = 0
DoEvents
Loop
pdfjob.cClose
Application.ActivePrinter = sDefaultPrinter ' restore default printer
End If
lbl_Exit:
Set pdfjob = Nothing
Exit Sub
err_handler:
MsgBox "Unable to initialize PDFCreator." & vbCr & vbCr & _
"This may be an indication that the PDF application has become corrupted, " & _
"or its spooler blocked by AV software." & vbCr & vbCr & _
"Re-installing PDF Creator may restore normal working."
Err.Clear
GoTo lbl_Exit
End Sub
Private Function GetPrinterFullName(Printer As String) As String
' This function returns the full name of the first printerdevice that matches Printer.
' Full name is like "PDFCreator on Ne01:" for a English Windows and like
' "PDFCreator sur Ne01:" for French.
' Created: Frans Bus, 2015. See http://pixcels.nl/set-activeprinter-excel
' see http://blogs.msdn.com/b/alejacma/archive/2008/04/11/how-to-read-a-registry-key-and-its-values.aspx
' see http://www.experts-exchange.com/Software/Microsoft_Applications/Q_27566782.html
Const HKEY_CURRENT_USER = &H80000001
Dim regobj As Object
Dim aTypes As Variant
Dim aDevices As Variant
Dim vDevice As Variant
Dim sValue As String
Dim v As Variant
Dim sLocaleOn As String
' get locale "on" from current activeprinter
v = Split(Application.ActivePrinter, Space(1))
sLocaleOn = Space(1) & CStr(v(UBound(v) - 1)) & Space(1)
' connect to WMI registry provider on current machine with current user
Set regobj = GetObject("WINMGMTS:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
' get the Devices from the registry
regobj.EnumValues HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", aDevices, aTypes
' find Printer and create full name
For Each vDevice In aDevices
' get port of device
regobj.GetStringValue HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", vDevice, sValue
' select device
If Left(vDevice, Len(Printer)) = Printer Then ' match!
' create localized printername
GetPrinterFullName = vDevice & sLocaleOn & Split(sValue, ",")(1)
Exit Function
End If
Next
lbl_Exit:
' at this point no match found
GetPrinterFullName = vbNullString
Exit Function
End Function
Sub Email_TB_PDF_Encrypted()
'Auf Basis der Einstellungen im Tabellenblatt "Setting" wird eine Email mit der aktuellen Arbeitsmappe als PDF-Anhang erzeugt und versendet
'Wichtig: Outlook muss so eingestellt sein, dass es seine Emails nicht mit Word erstellt!
'(Outlook: Extras_Optionen Email-Format Tabulator: Feld "Email mit MS Office Word bearbeiten muss deaktiviert sein!)
'Sonst wird der Dateilink nicht eingefügt.
'Working in Office 2000-2007
Dim oApp As Outlook.Application
Dim OutMail As MailItem
Dim strbody As String
Dim fdatum As String
Dim VorschauBereich As Range
Dim Tabnr As Integer
Dim Tabtext As String
Dim mastersheet As Worksheet
Set mastersheet = Workbooks(mastersheetfilename).Worksheets("Setting")
Dim strTo As String
Dim strCC As String
Dim strBCC As String
Dim vFilenamePDF As String
'Erstellung des Dateipfades (analog zur Funktion SaveBWWorkbook) a
fdatum = Format(Now - 1, "YYYYMMDD") 'Datum für Filename
sverz = mastersheet.Cells(17, "B")
vFilenamePDF = sverz & mastersheet.Cells(18, "B") & "_" & fdatum & ".pdf"
'strbody = "<a href=" & "file:" & vFilename & ">" & vFilename & "</a>"
'Erstellung des Pfadnamens e
mastersheet.Visible = xlSheetHidden
Set oApp = CreateObject("Outlook.application")
Set OutMail = oApp.CreateItem(0)
'Erstellen der Email a
'Fall 1: ohne Verwednung des Vorschaubereichs
If ((mastersheet.Cells(33, "B") = "") And (mastersheet.Cells(34, "B") = "")) Then
With OutMail
.To = strTo
.CC = strCC
.BCC = strBCC
.Subject = mastersheet.Cells(31, "B")
.HTMLBody = mastersheet.Cells(35, "B")
.Sensitivity = 3
'You can add a file like this
.Attachments.Add (vFilenamePDF)
.Send
'or.Display
End With
Else
'Fall 2: mit Verwendung des Vorschaubereichs
With OutMail
.To = strTo
.CC = strCC
.BCC = strBCC
.Subject = mastersheet.Cells(31, "B")
.HTMLBody = "<br><br>" & RangetoHTML(VorschauBereich)
.Sensitivity = 4
'You can add a file like this
.Attachments.Add (vFilenamePDF)
.Send
'or.Display
End With
End If
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
'Erstellen der Email e
mastersheet.Visible = xlSheetVisible
End Sub
我想附加用pdfcreator 1.7.3生成的文件作为电子邮件附件附加，而不将其临时存储在任何位置。
正如您在下面列出的不赞成使用的代码中所看到的那样，该函数返回了Object，因此我假设尚未生成任何临时文件。这个假设对吗？我认为我应该将子过程转换为一个函数，以便该函数返回对象。这个假设对吗？
''deprecated with 05th March 2019, since created PDF is not encrypted
''Updated Version of PDF - Creation to match criteria of Windows 10 update 1803 https://www.rondebruin.nl/win/s5/pdf.htm
'Function RDB_Create_PDF(Myvar As Object, FixedFilePathName As String, _
' OverwriteIfFileExist As Boolean, OpenPDFAfterPublish As Boolean, Optional ByVal PDFPathAndFilename As Variant) As String
' Dim FileFormatstr As String
'
'
' 'Test to see if the Microsoft Create/Send add-in is installed. Not necessary with Update 1803, so I commented it out
'' If Dir(Environ("commonprogramfiles") & "\Microsoft Shared\OFFICE" _
'' & Format(Val(Application.Version), "00") & "\EXP_PDF.DLL") <> "" Then
'
' If FixedFilePathName = "" Then
' 'Open the GetSaveAsFilename dialog to enter a file name for the PDF file.
' FileFormatstr = "PDF Files (*.pdf), *.pdf"
' PDFPathAndFilename = Application.GetSaveAsFilename("", filefilter:=FileFormatstr, _
' Title:="Create PDF")
'
' 'If you cancel this dialog, exit the function.
' If PDFPathAndFilename = False Then Exit Function
' Else
' PDFPathAndFilename = FixedFilePathName
' End If
'
' 'If OverwriteIfFileExist = False then test to see if the PDF
' 'already exists in the folder and exit the function if it does.
' If OverwriteIfFileExist = False Then
' If Dir(PDFPathAndFilename) <> "" Then Exit Function
' End If
'
' 'Now export the PDF file.
' On Error Resume Next
' Myvar.ExportAsFixedFormat _
' Type:=xlTypePDF, _
' Filename:=PDFPathAndFilename, _
' Quality:=xlQualityStandard, _
' IncludeDocProperties:=True, _
' IgnorePrintAreas:=False, _
' OpenAfterPublish:=OpenPDFAfterPublish
' On Error GoTo 0
'
' If Dir(PDFPathAndFilename) <> "" Then
' 'Call EncryptPDF(PDFPathAndFilename)
' ElseIf Dir(PDFPathAndFilename) = "" Then
' MsgBox "Dateiname konnte nicht eingelesen werden!"
' End If
'
' 'If the export is successful, return the file name.
' If Dir(PDFPathAndFilename) <> "" Then RDB_Create_PDF = PDFPathAndFilename
'End Function
由于我们不能再使用Ron弃用的代码了（因为生成的文件未加密），因此我们必须实现它。感谢您的指导和帮助！