VBA Print To PDF And Save With Automatic File Name - Stack Overflow

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.