VBA Print to PDF and Save with Automatic File Name

Question

I have a code that prints a selected area in a worksheet to PDF and allows user to select folder and input file name.

There are two things I want to do though:

1. Is there a way that the PDF file can create a folder on the users desktop and save the file with a file name based on specific cells in the sheet?
2. If multiple copies of the same sheet are saved/printed to PDF can each copy have a number eg. 2, 3 in the filename based on the copy number?**

Here is the code I have so far:

Sub PrintRentalForm()
Dim filename As String

Worksheets("Rental").Activate


filename = Application.GetSaveAsFilename(InitialFileName:="", _
                                     FileFilter:="PDF Files (*.pdf), *.pdf", _
                                     Title:="Select Path and Filename to save")

If filename <> "False" Then
With ActiveWorkbook
    .Worksheets("Rental").Range("A1:N24").ExportAsFixedFormat Type:=xlTypePDF, _
                                              filename:=filename, _
                                              Quality:=xlQualityStandard, _
                                              IncludeDocProperties:=True, _
                                              IgnorePrintAreas:=False, _
                                              OpenAfterPublish:=True
End With
End If


filename = Application.GetSaveAsFilename(InitialFileName:="", _
                                     FileFilter:="PDF Files (*.pdf), *.pdf", _
                                     Title:="Select Path and Filename to save")

If filename <> "False" Then
With ActiveWorkbook
    .Worksheets("RentalCalcs").Range("A1:N24").ExportAsFixedFormat Type:=xlTypePDF, _
                                              filename:=filename, _
                                              Quality:=xlQualityStandard, _
                                              IncludeDocProperties:=True, _
                                              IgnorePrintAreas:=False, _
                                              OpenAfterPublish:=False
End With
End If

End Sub`

UPDATE: I have changed the code and references and it now works. I have linked the code to a commandbutton on the Rental Sheet -

Private Sub CommandButton1_Click()
Dim filenamerental As String
Dim filenamerentalcalcs As String
Dim x As Integer


x = Range("C12").Value
Range("C12").Value = x + 1

Worksheets("Rental").Activate

Path = CreateObject("WScript.Shell").specialfolders("Desktop")

filenamerental = Path & "\" & Sheets("Rental").Range("O1")

'ThisWorkbook.Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select
Worksheets("Rental").Range("A1:N24").Select
Selection.ExportAsFixedFormat _
    Type:=xlTypePDF, _
    Filename:=filenamerental, _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=False

Worksheets("RentalCalcs").Activate

Path = CreateObject("WScript.Shell").specialfolders("Desktop")

filenamerentalcalcs = Path & "\" & Sheets("RentalCalcs").Range("O1")

'ThisWorkbook.Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select
Worksheets("RentalCalcs").Range("A1:N24").Select
Selection.ExportAsFixedFormat _
    Type:=xlTypePDF, _
    Filename:=filenamerentalcalcs, _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=False

Worksheets("Rental").Activate
Range("D4:E4").Select

End Sub

Answer 1

Hopefully this is self explanatory enough. Use the comments in the code to help understand what is happening. Pass a single cell to this function. The value of that cell will be the base file name. If the cell contains "AwesomeData" then we will try and create a file in the current users desktop called AwesomeData.pdf. If that already exists then try AwesomeData2.pdf and so on. In your code you could just replace the lines filename = Application..... with filename = GetFileName(Range("A1"))

Function GetFileName(rngNamedCell As Range) As String
    Dim strSaveDirectory As String: strSaveDirectory = ""
    Dim strFileName As String: strFileName = ""
    Dim strTestPath As String: strTestPath = ""
    Dim strFileBaseName As String: strFileBaseName = ""
    Dim strFilePath As String: strFilePath = ""
    Dim intFileCounterIndex As Integer: intFileCounterIndex = 1

    ' Get the users desktop directory.
    strSaveDirectory = Environ("USERPROFILE") & "\Desktop\"
    Debug.Print "Saving to: " & strSaveDirectory

    ' Base file name
    strFileBaseName = Trim(rngNamedCell.Value)
    Debug.Print "File Name will contain: " & strFileBaseName

    ' Loop until we find a free file number
    Do
        If intFileCounterIndex > 1 Then
            ' Build test path base on current counter exists.
            strTestPath = strSaveDirectory & strFileBaseName & Trim(Str(intFileCounterIndex)) & ".pdf"
        Else
            ' Build test path base just on base name to see if it exists.
            strTestPath = strSaveDirectory & strFileBaseName & ".pdf"
        End If

        If (Dir(strTestPath) = "") Then
            ' This file path does not currently exist. Use that.
            strFileName = strTestPath
        Else
            ' Increase the counter as we have not found a free file yet.
            intFileCounterIndex = intFileCounterIndex + 1
        End If

    Loop Until strFileName <> ""

    ' Found useable filename
    Debug.Print "Free file name: " & strFileName
    GetFileName = strFileName

End Function

The debug lines will help you figure out what is happening if you need to step through the code. Remove them as you see fit. I went a little crazy with the variables but it was to make this as clear as possible.

In Action

My cell O1 contained the string "FileName" without the quotes. Used this sub to call my function and it saved a file.

Sub Testing()
    Dim filename As String: filename = GetFileName(Range("o1"))

    ActiveWorkbook.Worksheets("Sheet1").Range("A1:N24").ExportAsFixedFormat Type:=xlTypePDF, _
                                              filename:=filename, _
                                              Quality:=xlQualityStandard, _
                                              IncludeDocProperties:=True, _
                                              IgnorePrintAreas:=False, _
                                              OpenAfterPublish:=False
End Sub

Where is your code located in reference to everything else? Perhaps you need to make a module if you have not already and move your existing code into there.