Tag: PDF

  • PDFCreator aansturen met LotusScript

    PDFCreator aansturen met LotusScript

    Voor een klant moest er een export gemaakt worden van alle Notes documenten in een database.
    Dit moest gebeuren door deze als PDF af te drukken.
    Als PDF printer heb ik gekozen voor de open source applicatie PDFCreator, dat makkelijk aan te sturen is en erg nette afdrukken maakt.
    Omdat er geen tijd was om te onderzoeken of dit op de achtergrond kon gebeuren heb ik gekozen om een eenvoudig script te maken dat via de Notes cliënt door een weergave loopt, elk document opent, de bestandsnaam aan PDFCreator doorgeeft via COM, afdrukt naar de default (PDF) printer, en het document sluit.

    Code

    Sub Initialize
    On Error GoTo ErrorHandler
    '....... Declare And Set items.....
    
    sPDFPath$ = "C:\"
    If Dir(sPDFPath$,16) = "" Then
    MsgBox sPDFPath$ & " kan niet worden geopend",16,"Export"
    End If
    
    Set PDFCreator = CreateObject("PDFCreator.clsPDFCreator")
    If Not PDFCreator.cStart("",True) Then
    MsgBox "PDF printer kan niet worden gestart",16,"Export"
    GoTo TheEnd
    End If
    
    Set Doc = View.GetFirstDocument
    Do Until Doc Is Nothing
    
    sPDFName$ = doc.NoteID & ".pdf"
    FileName$ = sPDFPath$ & sPDFName$
    If Not Dir(FileName$) = "" Then
    Kill FileName$
    End If
    
    With PDFCreator
    .cOption("UseAutosave") = 1
    .cOption("UseAutosaveDirectory") = 1
    .cOption("AutosaveDirectory") = sPDFPath$
    .cOption("AutosaveFilename") = sPDFName$
    .cOption("AutosaveFormat") = 0
    .cClearCache
    End With
    
    Set uiDoc = ws.EditDocument(False,Doc,True,"",True,True)
    Call uiDoc.Print(1)
    Call uiDoc.Close(True)
    Set uiDoc = Nothing
    
    If Not isFileCreated(FileName$) Then
    'Foutafhandeling
    End If
    Set Doc = View.GetNextDocument(Doc)
    Loop
    
    TheEnd:
    On Error Resume Next
    PDFCreator.cClose
    Set PDFCreator = Nothing
    Exit Sub
    
    ErrorHandler:
    MsgBox GetThreadInfo(1) & " " & Error & " (" & Err & ") op regel " & Erl & "."
    Resume TheEnd
    End Sub
    
    Function isFileCreated ( filePath As String ) As Boolean
    On Error GoTo errorHandler
    Dim counter As Integer
    Dim fSize As Long
    
    isFileCreated = False
    Do While Dir$(filePath$, 0) = ""
    If counter > 30 Then
    Exit Function
    End If
    Sleep 1
    counter = counter + 1
    Loop
    
    fSize = FileLen(filePath$)
    Counter = 0
    Do While (FileLen(filePath$) = 0 Or FileLen(filePath$) > fSize)
    fSize = FileLen(filePath$)
    If counter > 30 Then
    Exit Function
    End If
    Sleep 1
    counter = counter + 1
    Loop
    
    isFileCreated = True
    
    Exit Function
    ErrorHandler:
    MsgBox GetThreadInfo(1) & " " & Error & " (" & Err & ") op regel " & Erl & "."
    Exit Function
    Resume Next
    End Function