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?

    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

  2. #2
    Administrator Ken Puls's Avatar
    Join Date
    Mar 2011
    Location
    Nanaimo, BC, Canada
    Posts
    2,274
    Articles
    57
    Blog Entries
    14
    Excel Version
    Excel Office 365 Insider
    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"
    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: http://www.excelguru.ca -||- Blog: http://www.excelguru.ca/blog -||- Forums: http://www.excelguru.ca/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

    Solved

    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
  •