Print Multiple Worksheets to Multiple PDF Files

Sub PDFDatafile()
'Author       : Ken Puls
'Macro Purpose: Print to PDF file using PDFCreator

'   Designed for early bind, set reference to PDFCreator
    Dim pdfjob As PDFCreator.clsPDFCreator
    Dim sPDFName As String
    Dim sPDFPreface As String
    Dim sPDFPath As String
    Dim sSheetsToPrint As String
    Dim sSheets() As String
    Dim lSheet As Long
    Dim bRestart As Boolean


    'Activate error handling and turn off screen updates
    On Error GoTo EarlyExit
    Application.ScreenUpdating = False
    Set pdfjob = New PDFCreator.clsPDFCreator
    
    '/// Set the preface for the PDF file name and the file path here! ///
    sPDFPreface = "OverzichtIAAS-"
    sPDFPath = ActiveWorkbook.Path & Application.PathSeparator


    '/// Record the sheets you want to print here! ///
    '/// Use sheet names separated by commas only  ///
    sSheetsToPrint = "ABCSolutions_Data,Apanta-GGZ_Data,Apanta Direct_Data,Aram_Data,Bremanger Quarry_Data,Damen_Data,De Beer Accountants_Data,ECTD_Data,F.Bontrup_Data,Geevers_Data,Gevo_Data,Hunting_Data,Hoogerdijk_Data,ITAM_Data,InkoopFocus_Data,Nummereen_Data,PPBest_Data,Scanton_Data,Tommy_Data,VanDiessen_Data,Wolters_Data,Zin_Data,Please_Data"


    'Check if PDFCreator is already running and attempt to kill the process if so
    Do
        bRestart = False
        Set pdfjob = New PDFCreator.clsPDFCreator
        If pdfjob.cStart("/NoProcessingAtStartup") = False Then
            'PDF Creator is already running.  Kill the existing process
            Shell "taskkill /f /im PDFCreator.exe", vbHide
            DoEvents
            Set pdfjob = Nothing
            bRestart = True
        End If
    Loop Until bRestart = False


    'Split the sheets into an array
    sSheets() = Split(sSheetsToPrint, ",")
    
    For lSheet = LBound(sSheets) To UBound(sSheets)
        'Check if worksheet is empty and skip if so
        If Not IsEmpty(Application.Sheets(sSheets(lSheet)).UsedRange) Then
            With pdfjob
                '/// Change the output file name here! ///
                sPDFName = sPDFPreface & Sheets(sSheets(lSheet)).Name & ".pdf"
                .cOption("UseAutosave") = 1
                .cOption("UseAutosaveDirectory") = 1
                .cOption("AutosaveDirectory") = sPDFPath
                .cOption("AutosaveFilename") = sPDFName
                .cOption("AutosaveFormat") = 0    ' 0 = PDF
                .cClearCache
            End With
    
            'Delete the PDF if it already exists
            If Dir(sPDFPath & sPDFName) = sPDFName Then Kill (sPDFPath & sPDFName)
    
            'Print the document to PDF
            Application.Sheets(sSheets(lSheet)).PrintOut copies:=1, ActivePrinter:="PDFCreator"
    
            'Wait until the print job has entered the print queue
            Do Until pdfjob.cCountOfPrintjobs = 1
                DoEvents
            Loop
            pdfjob.cPrinterStop = False
    
            'Wait until the file shows up before moving on
            'Important:  Counter must reach zero or hangs on next iteration
            Do Until pdfjob.cCountOfPrintjobs = 0
                DoEvents
            Loop
        End If
    Next lSheet
    
Cleanup:
    'Release objects and terminate PDFCreator
    Set pdfjob = Nothing
    Shell "taskkill /f /im PDFCreator.exe", vbHide
    On Error GoTo 0
    Application.ScreenUpdating = True
    Exit Sub


EarlyExit:
    'Inform user of error, and go to cleanup section
    MsgBox "ERROR, ERROR, Jammer Marielle, er gaat iets mis met de PDFCreator of met de Macro. Klop even bij je TWC collega's aan :)"
'There was an error encountered.  PDFCreator has" & vbCrLf & _ has been terminated., _vbCritical vbOKOnly, "Error"
    Resume Cleanup
End Sub

Sub PDFSpecificatie()
'Author       : Ken Puls 
'Macro Purpose: Print to PDF file using PDFCreator

'   Designed for early bind, set reference to PDFCreator
    Dim pdfjob As PDFCreator.clsPDFCreator
    Dim sPDFName As String
    Dim sPDFPreface As String
    Dim sPDFPath As String
    Dim sSheetsToPrint As String
    Dim sSheets() As String
    Dim lSheet As Long
    Dim bRestart As Boolean


    'Activate error handling and turn off screen updates
    On Error GoTo EarlyExit
    Application.ScreenUpdating = False
    Set pdfjob = New PDFCreator.clsPDFCreator
    
    '/// Set the preface for the PDF file name and the file path here! ///
    sPDFPreface = "IAASSpecificatie-"
    sPDFPath = ActiveWorkbook.Path & Application.PathSeparator


    '/// Record the sheets you want to print here! ///
    '/// Use sheet names separated by commas only  ///
    sSheetsToPrint = "ABCSolutions_Fact,Apanta-GGZ_Fact,Apanta Direct_Fact,Aram_Fact,Belle Rives Holding_Fact,Bremanger Quarry_Fact,Creanza_Fact,Concept Factory_Fact,Damen_Fact,De Beer Accountants_Fact,ECTD_Fact,F.Bontrup_Fact,Geevers_Fact,Gevo_Fact,Het Nieuwe Trivium_Fact,Hoogerdijk_Fact,Hunting_Fact,InkoopFocus_Fact,Intelco_Fact,ITAM_Fact,Kluijtmans_Fact,Klomp Advies_Fact,LAN_Fact,Lands-Heeren_Fact,Mitrofresh_Fact,Maton_fact,Nummereen_Fact,Num1Airwatch_Fact,Pain Danvo_Fact,PPBest_Fact,Rijwiel CC_Fact,Scanton_Fact,Tedopres_Fact,Tommy_Fact,Van Lunen_Fact,VanDiessen_Fact,Wolters_Fact,Zin_Fact,Please_Fact"


    'Check if PDFCreator is already running and attempt to kill the process if so
    Do
        bRestart = False
        Set pdfjob = New PDFCreator.clsPDFCreator
        If pdfjob.cStart("/NoProcessingAtStartup") = False Then
            'PDF Creator is already running.  Kill the existing process
            Shell "taskkill /f /im PDFCreator.exe", vbHide
            DoEvents
            Set pdfjob = Nothing
            bRestart = True
        End If
    Loop Until bRestart = False


    'Split the sheets into an array
    sSheets() = Split(sSheetsToPrint, ",")
    
    For lSheet = LBound(sSheets) To UBound(sSheets)
        'Check if worksheet is empty and skip if so
        If Not IsEmpty(Application.Sheets(sSheets(lSheet)).UsedRange) Then
            With pdfjob
                '/// Change the output file name here! ///
                sPDFName = sPDFPreface & Sheets(sSheets(lSheet)).Name & ".pdf"
                .cOption("UseAutosave") = 1
                .cOption("UseAutosaveDirectory") = 1
                .cOption("AutosaveDirectory") = sPDFPath
                .cOption("AutosaveFilename") = sPDFName
                .cOption("AutosaveFormat") = 0    ' 0 = PDF
                .cClearCache
            End With
    
            'Delete the PDF if it already exists
            If Dir(sPDFPath & sPDFName) = sPDFName Then Kill (sPDFPath & sPDFName)
    
            'Print the document to PDF
            Application.Sheets(sSheets(lSheet)).PrintOut copies:=1, ActivePrinter:="PDFCreator"
    
            'Wait until the print job has entered the print queue
            Do Until pdfjob.cCountOfPrintjobs = 1
                DoEvents
            Loop
            pdfjob.cPrinterStop = False
    
            'Wait until the file shows up before moving on
            'Important:  Counter must reach zero or hangs on next iteration
            Do Until pdfjob.cCountOfPrintjobs = 0
                DoEvents
            Loop
        End If
    Next lSheet
    
Cleanup:
    'Release objects and terminate PDFCreator
    Set pdfjob = Nothing
    Shell "taskkill /f /im PDFCreator.exe", vbHide
    On Error GoTo 0
    Application.ScreenUpdating = True
    Exit Sub


EarlyExit:
    'Inform user of error, and go to cleanup section
    MsgBox "ERROR, ERROR, Jammer Marielle, er gaat iets mis met de PDFCreator of met de Macro. Klop even bij je TWC collega's aan :)"
'There was an error encountered.  PDFCreator has" & vbCrLf & _ has been terminated., _vbCritical vbOKOnly, "Error"
    Resume Cleanup
End Sub

'   Designed for early bind, set reference to PDFCreator

[COLOR=#3E3E3E]Option Explicit[/COLOR]
Sub PrintToPDF_Early()'Author       : Ken Puls 'Macro Purpose: Print to PDF file using PDFCreator' Designed for early bind, set reference to PDFCreator    Dim pdfjob As PDFCreator.clsPDFCreator    Dim sPDFName As String    Dim sPDFPath As String    Dim bRestart As Boolean    '/// Change the output file name here! ///    sPDFName = "testPDF.pdf"    sPDFPath = ActiveWorkbook.Path & Application.PathSeparator    'Check if worksheet is empty and exit if so    If IsEmpty(ActiveSheet.UsedRange) Then Exit Sub    'Activate error handling and turn off screen updates    On Error GoTo EarlyExit    Application.ScreenUpdating = False    Set pdfjob = New PDFCreator.clsPDFCreator    'Check if PDFCreator is already running and attempt to kill the process if so    Do        bRestart = False        Set pdfjob = New PDFCreator.clsPDFCreator        If pdfjob.cStart("/NoProcessingAtStartup") = False Then            'PDF Creator is already running.  Kill the existing process            Shell "taskkill /f /im PDFCreator.exe", vbHide            DoEvents            Set pdfjob = Nothing            bRestart = True        End If    Loop Until bRestart = False    'Assign settings for PDF job    With pdfjob        .cOption("UseAutosave") = 1        .cOption("UseAutosaveDirectory") = 1        .cOption("AutosaveDirectory") = sPDFPath        .cOption("AutosaveFilename") = sPDFName        .cOption("AutosaveFormat") = 0    ' 0 = PDF        .cClearCache    End With    'Delete the PDF if it already exists    If Dir(sPDFPath & sPDFName) = sPDFName Then Kill (sPDFPath & sPDFName)    'Print the document to PDF    ActiveSheet.PrintOut copies:=1, ActivePrinter:="PDFCreator"    'Wait until the print job has entered the print queue    Do Until pdfjob.cCountOfPrintjobs = 1        DoEvents    Loop    pdfjob.cPrinterStop = False    'Wait until the file shows up before closing PDF Creator    Do        DoEvents    Loop Until Dir(sPDFPath & sPDFName) = sPDFNameCleanup:    'Release objects and terminate PDFCreator    Set pdfjob = Nothing    Shell "taskkill /f /im PDFCreator.exe", vbHide    On Error GoTo 0    Application.ScreenUpdating = True    Exit SubEarlyExit:    'Inform user of error, and go to cleanup section    MsgBox "There was an error encountered.  PDFCreator has" & vbCrLf & _           "has been terminated.  Please try again.", _           vbCritical + vbOKOnly, "Error"    Resume Cleanup [COLOR=#3E3E3E]End Sub[/COLOR]