Appending is very slow - Is there a faster method?

[bgshoenhair]

My code is listed below and I'm hoping someone can help me increase the processing speed as it is very slow for such limited text compilation.
Is there a way that I can trap when ALL the appending is done?

Thanks...

Code: Select all

Option Explicit

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function ShellExecute Lib "Shell32" Alias "ShellExecuteA" (ByVal hwnd As Long, _
        ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, _
        ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Private Sub PrintToSinglePdf()

    Dim PDFPFactory As New PXCComLib5.CPXCControlEx
    Dim PDFPrinter As PXCComLib5.CPXCPrinter
    Dim PdfName As String
    Dim TextName As String
    Dim i As Integer
    'On Error GoTo CleanUp

    Set PDFPrinter = PDFPFactory.Printer("", "PDF-XChange 2012 Sample", "<YOUR REG CODE>", "<YOUR DEV CODE>")

    PDFPrinter.SetAsDefaultPrinter


    PdfName = "C:\test.pdf"    '**************pdf name here**************

    With PDFPrinter
        .ResetDefaults
        .Option("Save.File") = PdfName
        .Option("Save.SaveType") = "Save"
        .Option("Save.ShowSaveDialog") = "No"
        .Option("Save.WhenExists") = "Append"
        .Option("Compression.Graphics") = "Yes"
        .Option("Compression.Text") = "Yes"
        .Option("Compression.ASCII") = "No"
        .Option("Compression.Color.Enabled") = "Yes"
        .Option("Compression.Color.Method") = "Auto"
        .Option("Compression.Indexed.Enabled") = "Yes"
        .Option("Compression.Indexed.Method") = "Auto"
        .Option("Compression.Mono.Enabled") = "Yes"
        .Option("Compression.Mono.Method") = "Auto"
        .Option("Fonts.EmbedAll") = 1
        .Option("Save.RunApp") = False 
        .Option("Save.RunCustom") = "No"
        .Option("Saver.ShowProgress") = "Yes"
    End With

    '********Quick test*************************************
    If FileExists(PdfName) Then Kill PdfName
    For i = 1 To 100
        TextName = "C:\testPrintToPdf" & i & ".txt"
        If FileExists(TextName) Then Kill TextName
        
        Dim intFile As Integer
        intFile = FreeFile
        Open TextName For Output As #intFile
        Print #intFile, "Test: " & TextName
        Close #intFile

        ShellExecute 0, "printto", TextName, """" + PDFPrinter.Name + """", vbNull, 11
        Sleep 1000
        If FileExists(TextName) Then Kill TextName
    Next i
    ShellExecute 0, "Open", PdfName, "", vbNull, 11
    '******************************************************
    
CleanUp:
    PDFPrinter.RestoreDefaultPrinter
    Set PDFPFactory = Nothing
    Set PDFPrinter = Nothing
    If Err Then MsgBox "Error Num:  " & Err.Number & vbNewLine & "Error Desc: " & Err.Description, vbSystemModal + vbInformation, "Error Occurred"    
End Sub

Function FileExists(FullFileName As Variant) As Boolean   
    On Error GoTo NotFound
    FileExists = Len(Dir(FullFileName)) > 0
    
    Exit Function
NotFound:
    FileExists = False   
End Function

[Ivan - Tracker Software]

Here is modification of your code to eliminate using Sleep()

Code: Select all

Option Explicit

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function ShellExecute Lib "Shell32" Alias "ShellExecuteA" (ByVal hwnd As Long, _
        ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, _
        ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Private bFinished As Boolean
Public WithEvents PDFPrinter As PXCComLib5.CPXCPrinter

Private Sub WaitForPrinter()
    Do Until bFinished
        DoEvents
    Loop
End Sub

Private Sub PDFPrinter_OnFileSaved(ByVal dwJob As Long, ByVal lpszFileName As String)
    bFinished = True
End Sub

Private Sub PrintToSinglePdf()

    Dim PDFPFactory As New PXCComLib5.CPXCControlEx
    Dim PdfName As String
    Dim TextName As String
    Dim i As Integer
    'On Error GoTo CleanUp

    Set PDFPrinter = PDFPFactory.Printer("", "PDF-XChange 2012 Sample", "<YOUR REG CODE>", "<YOUR DEV CODE>")
    
    PDFPrinter.SetAsDefaultPrinter


    PdfName = "C:\test.pdf"    '**************pdf name here**************

    With PDFPrinter
        .ResetDefaults
        .Option("Save.File") = PdfName
        .Option("Save.SaveType") = "Save"
        .Option("Save.ShowSaveDialog") = "No"
        .Option("Save.WhenExists") = "Append"
        .Option("Compression.Graphics") = "Yes"
        .Option("Compression.Text") = "Yes"
        .Option("Compression.ASCII") = "No"
        .Option("Compression.Color.Enabled") = "Yes"
        .Option("Compression.Color.Method") = "Auto"
        .Option("Compression.Indexed.Enabled") = "Yes"
        .Option("Compression.Indexed.Method") = "Auto"
        .Option("Compression.Mono.Enabled") = "Yes"
        .Option("Compression.Mono.Method") = "Auto"
        .Option("Fonts.EmbedAll") = 1
        .Option("Save.RunApp") = False
        .Option("Save.RunCustom") = "No"
        .Option("Saver.ShowProgress") = "Yes"
    End With

    '********Quick test*************************************
    If FileExists(PdfName) Then Kill PdfName
    For i = 1 To 100
        TextName = "C:\testPrintToPdf" & i & ".txt"
        If FileExists(TextName) Then Kill TextName
        
        Dim intFile As Integer
        intFile = FreeFile
        Open TextName For Output As #intFile
        Print #intFile, "Test: " & TextName
        Close #intFile

        bFinished = False
        ShellExecute 0, "printto", TextName, """" + PDFPrinter.Name + """", vbNull, 11
        WaitForPrinter
        
         If FileExists(TextName) Then Kill TextName
    Next i
    ' Sleep 10000
    ShellExecute 0, "Open", PdfName, "", vbNull, 11
    '******************************************************
    
CleanUp:
    PDFPrinter.RestoreDefaultPrinter
    Set PDFPFactory = Nothing
    Set PDFPrinter = Nothing
    If Err Then MsgBox "Error Num:  " & Err.Number & vbNewLine & "Error Desc: " & Err.Description, vbSystemModal + vbInformation, "Error Occurred"
End Sub

Function FileExists(FullFileName As Variant) As Boolean
    On Error GoTo NotFound
    FileExists = Len(Dir(FullFileName)) > 0
    
    Exit Function
NotFound:
    FileExists = False
End Function

[bgshoenhair]

Is there anyway to have the "saver" only compile after the last document is printed instead of compiling after every single document? This would be a time saver.

[Ivan - Tracker Software]

There is such way for end users, but unfortunately it is not fully available in the SDK.
I can try to add it in next builds.