Results 1 to 3 of 3

Thread: Increment File Name

  1. #1

    Increment File Name

    Register for a FREE account, and/
    or Log in to avoid these ads!

    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?

     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
            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
                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
                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
                pdfjob.cPrinterStop = False
                'Wait until the file shows up
                'Important:  Counter must reach zero or hangs on next iteration
                Do Until pdfjob.cCountOfPrintjobs = 0
            End If
        Next lSheet
        'Release objects and terminate program
        Set pdfjob = Nothing
        Shell "taskkill /f /im PDFCreator.exe", vbHide
        On Error GoTo 0
        Application.ScreenUpdating = True
        Exit Sub
        '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

  2. #2
    Administrator Ken Puls's Avatar
    Join Date
    Mar 2011
    Nanaimo, BC, Canada
    Blog Entries
    Excel Version
    Excel Office 365 Insider
    How about just adding the time to the printout as well? Replace:

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

    sPDFName = Sheets(lSheet).Name & replace(format(now(),"mm-dd-yyyy hh:mm:ss"),":","-") & ".pdf"
    Ken Puls, FCPA, FCMA, MS MVP

    Learn to Master Your Data at the Power Query Academy (the world's most comprehensive online Power Query training), with my book M is for Data Monkey, or our new Power Query Recipe cards!

    Main Site: -||- Blog: -||- Forums:
    Check out the Excelguru Facebook Fan Page -||- Follow Me on Twitter

    If you've been given VBA code (a macro) for your solution, but don't know where to put it, CLICK HERE.

  3. #3


    Thanks for the advice I got it to work.

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts