Script-Beispiel:
Sub Initialize
' -------------------------------------------------------------------
' --- Deklarationen / Settings
' -------------------------------------------------------------------
Dim ws As New NotesUIWorkspace
Dim uidoc As NotesUIDocument
Dim doc, docPG As NotesDocument
Dim session As New NotesSession
Dim db As NotesDatabase
Set db = session.CurrentDatabase
Dim dc As NotesDocumentCollection
Set dc = db.UnprocessedDocuments
ok = Messagebox("Wollen Sie die " & dc.Count & " ausgewählten Dokumente mit dem PDFCreator konvertieren?", 4+32, "PDFCreator | Konverter")
If ok = 7 Then Exit Sub
' -------------------------------------------------------------------
' --- Globale Konfiguration einlesen
' -------------------------------------------------------------------
Set docPG = db.GetProfileDocument("($Config)")
cfg_pcspfad = docPG.cfg_PCSPfad(0)
If Right(cfg_pcspfad, 1) <> "\" Then cfg_pcspfad = cfg_pcspfad & "\"
cfg_pcsfile = docPG.cfg_PCSFile(0)
cfg_pcsattfile = docPG.cfg_PCSAttFile(0)
cfg_pcsformat = Lcase(docPG.cfg_PCSFormat(0))
cfg_pcsfile = cfg_pcsfile & "." & cfg_pcsformat
' PDFCreator "simuliert" Verwendung des PDF Servers (Felder setzen)
cfg_pcs_epdfsim = docPG.cfg_PCS_ePDFSim(0)
If cfg_pcs_epdfsim <> "" Then
cfg_resultcodegw = docPG.ResultCodeGW(0)
If cfg_resultcodegw = "" Then cfg_resultcodegw = "131"
cfg_pcsfile = docPG.cfg_ePDF_OutputFileName(0)
End If
fpath = cfg_pcspfad
ffile = cfg_pcsfile
' -------------------------------------------------------------------
' init PDFCreator
Set oPDFC = CreateObject("PDFCreator.clsPDFCreator")
oPDFC.cStart("/NoProcessingAtStartup")
oPDFC.cOption("UseAutosave") = 1
oPDFC.cOption("UseAutosaveDirectory") = 1
oPDFC.cOption("AutosaveFormat") = 0 ' 0=PDF, 1=PNG, 2=JPG, 3=BMP, 4=PCX, 5=TIFF, 6=PS, 7= EPS, 8=ASCII
DefaultPrinter = oPDFC.cDefaultprinter
oPDFC.cDefaultprinter = "PDFCreator"
oPDFC.cClearCache
oPDFC.cOption("AutosaveDirectory") = fpath
oPDFC.cOption("AutosaveFilename") = ffile
Set doc = dc.GetFirstDocument
unid = doc.UniversalID
c = 0
Do Until doc Is Nothing
c = c + 1
oPDFC.cPrinterStop = True
' document was already converted
If doc.ePDF_flg(0) > "" Then
Print "Document was alreday converted!"
Goto weiter
End If
' print NotesDocument at first ...
i = 1
Set uidoc = ws.EditDocument (False, doc)
Call uidoc.Print(1)
Call uidoc.Close(True) ' If True, the document is immediately closed. If False, closing the document may be delayed
Set rtitem = doc.GetFirstItem( "Body" )
If Not doc.HasEmbedded Then
Goto no_object
End If
If Not rtitem Is Nothing And rtitem.Type = RICHTEXT Then
Forall o In rtitem.EmbeddedObjects
i = i + 1
Print fpath & o.Name
Call o.ExtractFile( fpath & o.Name )
' check if attachment is printable
isPrintable = oPDFC.cIsPrintable(fpath & o.Name)
If isPrintable = False Then
Print "Converting: " & unid & " " & o.Name & " An error is occured: File is not printable! ", 0+16, ""
Goto weiter ' Weiter mit nächstem Dokument
End If
' and now print all attachments
Print "Printing -> " & fpath & o.Name
oPDFC.cPrintfile(fpath & o.Name)
End Forall
End If
no_object:
' count print jobs in queue
Do Until oPDFC.cCountOfPrintjobs = i
Doevents
Loop
' combine all print jobs to one document
oPDFC.cCombineAll
oPDFC.cPrinterStop = False
' let PDFCreator print all jobs from queue
Do Until oPDFC.cCountOfPrintjobs = 0
Doevents
Loop
' release
Sleep(.1)
oPDFC.cDefaultprinter = DefaultPrinter
oPDFC.cClearcache
Sleep(.1)
' attach created PDF file
If cfg_pcsattfile <> "" Or cfg_pcs_epdfsim <> "" Then
Set rtitem = doc.GetFirstItem("Body")
If rtitem Is Nothing Then
Set rtitem = doc.CreateRichTextItem( "Body" )
End If
Set object = rtitem.EmbedObject ( EMBED_ATTACHMENT, "", fpath & ffile )
If cfg_pcs_epdfsim <> "" Then
doc.ePDF_flg = Date$ & " " & Time$ & " PDFCreator"
doc.ResultCodeGW = cfg_resultcodegw
End If
Call doc.Save( True, True )
End If
Print "Converting document " & c & " / " & dc.Count
weiter:
Sleep(1)
Set doc = dc.GetNextDocument(doc)
Loop
Set oPDFC = Nothing
Print dc.Count & " Dokumente verarbeitet."
Dim uiview As NotesUIView
Set uiview = ws.CurrentView
Call uiview.DeselectAll
Exit Sub
error_handle:
' Handle your own error handle ... ;-p
End Sub