Increment File Name

p_smith

New member
Joined
Jun 14, 2013
Messages
6
Reaction score
0
Points
0
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
 
How about just adding the time to the printout as well? Replace:

Code:
sPDFName = Sheets(lSheet).Name & Format(Now, " mm-dd-yyyy") & ".pdf"

With:

Code:
sPDFName = Sheets(lSheet).Name & replace(format(now(),"mm-dd-yyyy hh:mm:ss"),":","-") & ".pdf"
 
Solved

Thanks for the advice I got it to work.
 
Back
Top