In Ken's Code, the program deletes any existing file. Without adding a ton of additional code can this be easily incremented? Just add a 1 or a 2 after the file name so that someone does not accidentally blow the file out?
Code:
Sub PrintToPDF()
Dim pdfjob As PDFCreator.clsPDFCreator
Dim sPDFName As String
Dim sPDFPath As String
Dim lSheet As Long
Dim bRestart As Boolean
On Error GoTo EarlyExit
Application.ScreenUpdating = False
Set pdfjob = New PDFCreator.clsPDFCreator
'/// Edit Output file path ///
sPDFPath = "C:\Users\pschmidt\Documents\New folder (2)"
'Check PDFCreator
Do
bRestart = False
Set pdfjob = New PDFCreator.clsPDFCreator
If pdfjob.cStart("/NoProcessingAtStartup") = False Then
'PDF Creator is running: Kill the existing process
Shell "taskkill /f /im PDFCreator.exe", vbHide
DoEvents
Set pdfjob = Nothing
bRestart = True
End If
Loop Until bRestart = False
For lSheet = 1 To ActiveWorkbook.Sheets.Count
If Not IsEmpty(Sheets(lSheet).UsedRange) Then
With pdfjob
'/// Edit Output file name ///
sPDFName = Sheets(lSheet).Name & Format(Now, " mm-dd-yyyy") & ".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
'Print the document
Worksheets(lSheet).PrintOut copies:=1, ActivePrinter:="PDFCreator"
'Wait until the print job has queued
Do Until pdfjob.cCountOfPrintjobs = 1
DoEvents
Loop
pdfjob.cPrinterStop = False
'Wait until the file shows up
'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 program
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 "There was an error and the file was not created. PDFCreator has" & vbCrLf & _
"has been terminated. Please try again.", _
vbCritical + vbOKOnly, "Error"
Resume Cleanup
End Sub