Vba To Check if a file exists and if it does, create a new pdf with a number.

[jondavis1987]

I have a vba to create a report in PDF format. Sometimes I'll need to create up to 4 pdf reports of the same product. When this happens the first report will essentially look like this. Product 1 11-2-20. This name is decided from formulas in cells and the vba uses the cell to name it. If i'm on report number 2 it would get saved as Product 1 11-2-20 #2. This would happen up to Product 1 11-2-20 #4. How would I modify this to see if the file exists and then to add the correct number to it?

'   Export source workbook to PDF
    With srcWB
        fName = srcWB.Sheets("A").Range("A!F19").Value
                Sheets(Array("A", "Sheet2")).Select
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
            "C:\Users\" & Environ("username") & "\Dropbox\Quality Control\Asphalt\Asphalt Reports\" & fName, _
        openafterpublish:=True, ignoreprintareas:=False
    End With
srcWB.Sheets("A").Select
Exit Sub

 

[Domenic]

The following code assumes...

1) Cell F19 contains the filename, but excludes the file extension (ie. Product 1 11-2-20).

2) The workbook running the code is the source workbook. If this is not the case, change the source workbook where specified.

Note that if a number within the existing files is missing, the file will be saved with that missing number before continuing with the next number in sequence. For example, let's say you already have the following existing files...

Product 1 11-2-20.pdf
Product 1 11-2-20 #1.pdf
Product 1 11-2-20 #3.pdf

In this case, the next file would be saved as Product 1 11-2-20 #2.pdf, not Product 1 11-2-20 #4.pdf. Then the next one would be saved as Product 1 11-2-20 #4.pdf, and so on.

Here's the code, which needs to be placed in a regular module...

Option Explicit

Sub test()

    Dim sourceFolder As String
    sourceFolder = "C:\Users\" & Environ("username") & "\Dropbox\Quality Control\Asphalt\Asphalt Reports"
 
    'check whether folder exists
    If Len(Dir(sourceFolder, vbDirectory)) = 0 Then
        MsgBox "'" & sourceFolder & "' does not exist!", vbExclamation, "Path to Folder"
        Exit Sub
    End If
 
    'make sure path ends with backslash
    If Right(sourceFolder, 1) <> "\" Then
        sourceFolder = sourceFolder & "\"
    End If
 
    Dim sourceWorkbook As Workbook
    Set sourceWorkbook = ThisWorkbook 'change the source workbook, if required
 
    Dim baseFilenameNoExt As String
    baseFilenameNoExt = sourceWorkbook.Sheets("A").Range("F19").Value 'filename excludes file extension
 
    Dim fileExt As String
    fileExt = ".pdf"
 
    'get saveas filename to export PDF file
    Dim saveAsExportFilename As String
    saveAsExportFilename = GetSaveAsExportFilename(sourceFolder, baseFilenameNoExt, fileExt)
 
    With sourceWorkbook
        .Activate 'needed to select the sheets
        .Sheets(Array("A", "Sheet2")).Select
        .ActiveSheet.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            fileName:=saveAsExportFilename, _
            openafterpublish:=True, _
            ignoreprintareas:=False
        .Sheets("A").Select
    End With

End Sub

Public Function GetSaveAsExportFilename(ByVal sourceFolder As String, ByVal baseFilenameNoExt As String, Optional ByVal fileExt As String = ".pdf") As String

    Dim tempFilename As String
    Dim fileCount As Long
 
    tempFilename = sourceFolder & baseFilenameNoExt & fileExt
 
    If Len(Dir(tempFilename, vbNormal)) > 0 Then
        fileCount = 0
        Do
            fileCount = fileCount + 1
            tempFilename = sourceFolder & baseFilenameNoExt & " #" & fileCount & fileExt
            If Len(Dir(tempFilename, vbNormal)) = 0 Then
                Exit Do
            End If
        Loop
    End If
 
    GetSaveAsExportFilename = tempFilename
 
End Function

Hope this helps!

 

[jondavis1987]

Thank you!

 

[Domenic]

You're very welcome, cheers!