I am using the below code to generate a PDF of my spreadsheet.
I need to add a feature that will check if the file name already exists in the directory that you are trying to save it in, and allows changing the name.
I know I need to create another variable of the file path, but am completely oblivious of how to do the rest.
Sub PrintPDFAll()
ThisWorkbook.Unprotect
Worksheets("Entry").Unprotect
Dim MySheetName As String
MySheetName = "Entry2"
Sheets("Entry").Copy After:=Sheets("Entry")
ActiveSheet.Name = MySheetName
Range("ALL").FormatConditions.Delete
Range("ALL").Interior.ColorIndex = 0
'turn off screen updating
Application.ScreenUpdating = False
'open dialog and set file type
Opendialog = Application.GetSaveAsFilename("", FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Quote")
'if no value is added for file name
If Opendialog = False Then
MsgBox "The operation was not successful"
Application.DisplayAlerts = False
Sheets("Entry2").Delete
Worksheets("Entry").Activate
Exit Sub
End If
'create the pdf
On Error Resume Next
Sheets("Summary").Move Before:=Sheets(1)
Sheets("Breakdown").Move Before:=Sheets(2)
Sheets("Entry2").Move Before:=Sheets(3)
Sheets(Array("Entry2", "Breakdown", "Summary")).Select
With ActiveSheet.PageSetup
.Orientation = xlPortrait
.Zoom = False
.FitToPagesWide = 1
.CenterHorizontally = True
.CenterVertically = True
.BottomMargin = 0
.TopMargin = 0
.RightMargin = 0
.LeftMargin = 0
End With
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Opendialog, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
'error handler
On Error GoTo 0
'clear the page breaks
ActiveSheet.DisplayPageBreaks = False
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets("Entry2").Delete
Sheets("Entry").Move Before:=Sheets(1)
Sheets("Breakdown").Move Before:=Sheets(2)
Sheets("Summary").Move Before:=Sheets(3)
Worksheets("Entry").Activate
Worksheets("Entry").Protect
ThisWorkbook.Protect
End Sub
I have just found myself needing a solution to the same problem as here, with a little more experience now, I have been able to solve it myself. I thought I may as well post how I did it in case anyone ever needs it.
I found the following function online, to search the directories:
Function IsFile(ByVal fName As String) As Boolean
'Returns TRUE if the provided name points to an existing file.
'Returns FALSE if not existing, or if it's a folder
On Error Resume Next
IsFile = ((GetAttr(fName) And vbDirectory) <> vbDirectory)
End Function
And then amended the following to my code, so that if a duplicate file is found, It loops until you enter a non-duplicate file name:
...
TryAgain:
...
Opendialog = Application.GetSaveAsFilename("", filefilter:="PDF Files (*.pdf), *.pdf", _
Title:="Your Doc")
'if no value is added for file name
If Opendialog = False Then
MsgBox "The operation was not successful"
Exit Sub
End If
If IsFile(Opendialog) = True Then
MsgBox "File Already Exists"
Opendialog = ""
End If
If Opendialog = "" Then
GoTo TryAgain
End If