Hallo,
ich habe mir ein kleines MS-Acces (VBA) Programm geschrieben, um eine Reihe von Word-Dokumenten (Office 2016) in verschlüsselte PDF-Dateien umzuwandeln und nutze dafür den PdfCreator (Vers. 3.4.1). Alles läuft auch ganz prima, nur gelegentlich kommt ein ausgeführter Druckjob nicht bei PdfCreator an. Hier mal der Code-Auszug:
Private iWordApp As Word.Application
Private PDFCreatorQueue
Private orgPrinter As String
Public Sub ConvDoc(ByVal fName As String)
Dim resDoc As Word.Document
Dim ok As Boolean
' Initialize PdfCreator
Set PDFCreatorQueue = CreateObject("PDFCreator.JobQueue")
If Not PDFCreatorQueue Is Nothing Then
PDFCreatorQueue.Initialize
End If
' Start MS-Word
Set iWordApp = New Word.Application
iWordApp.Visible = True
' Word-Drucker zu PDFCreator wechseln
With iWordApp.Dialogs(wdDialogFilePrintSetup)
orgPrinter = .Printer
.Printer = "PDFCreator"
.DoNotSetAsSysDefault = True
.Execute
End With
' Word-Dokument öffnen
Set resDoc = iWordApp.Documents.Open(FileName:=fName , ReadOnly:=True, Visible:=False)
' Dokument zu PDF konvertieren
' ---------------------------------------------------
Do
resDoc.PrintOut True
ok = PrintPdf(fName, "xxx", False, False, True)
' Dieser Loop wird benötigt, da der Print-Job manchmal schlicht nicht ankommt
If Not ok Then
ok = (MsgBox("Fehler beim PDF-Export. Nochmal versuchen?", vbYesNo) = vbNo)
End If
Loop Until ok
' ---------------------------------------------------
' Word schließen, Drucker zurücksetzen
If Not iWordApp Is Nothing Then
With iWordApp.Dialogs(wdDialogFilePrintSetup)
.Printer = orgPrinter
.DoNotSetAsSysDefault = True
.Execute
End With
iWordApp.Application.Quit
Set iWordApp = Nothing
End If
' PdfCreator schließen
If Not PDFCreatorQueue Is Nothing Then
PDFCreatorQueue.ReleaseCom
End If
Set PDFCreatorQueue = Nothing
End Sub
' ==========================================================
Public Function PrintPdf(ByVal fName As String, ByVal UserPwd As String, _
ByVal mayCopy As Boolean, ByVal mayEdit As Boolean, _
ByVal mayPrint As Boolean) As Boolean
On Error GoTo Err_Protect
Dim job As Object
PrintPdf = False
' Document printing has to be started before
If PDFCreatorQueue.WaitForJob(15) Then
Set job = PDFCreatorQueue.NextJob()
If Not job Is Nothing Then
With job
.SetProfileByGuid "DefaultGuid"
.SetProfileSetting "PdfSettings.Security.Enabled", "true"
.SetProfileSetting "PdfSettings.Security.EncryptionLevel", "Rc128Bit"
.SetProfileSetting "PdfSettings.Security.OwnerPassword", "mysecretpwd"
.SetProfileSetting "PdfSettings.Security.RequireUserPassword", "true"
.SetProfileSetting "PdfSettings.Security.UserPassword", UserPwd
.SetProfileSetting "PdfSettings.Security.AllowPrinting", IIf(mayPrint, "true", "false")
.SetProfileSetting "PdfSettings.Security.AllowToCopyContent", IIf(mayCopy, "true", "false")
.SetProfileSetting "PdfSettings.Security.AllowToEditTheDocument", IIf(mayEdit, "true", "false")
.ConvertTo fName
While Not .IsFinished()
DoEvents
Wend
PrintPdf = .IsSuccessful()
End With
End If
End If
Exit_Protect:
On Error Resume Next
Set job = Nothing
Exit Function
Err_Protect:
MsgBox "myPdfConv.PrintPdf:" & chr(13) & chr(10) & err.Description
Resume Exit_Protect
End Function
Hat jemand eine Idee, wo das Problem liegen könnte? Habe ich vielleicht etwas vergessen? Bin für jede Hilfe dankbar.
LG,
Lemmi.
