Save without overwriting current files

Question

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

Check this out from this site. Several answers to help you (https://stackoverflow.com/questions/11573914/check-if-the-file-exists-using-vba) — Mitch, Sep 09 '17 at 16:39
I've had a look, and none of them are helping :'( I have edited the code, trying to blag my way through it but am stuck at the moment — George, Sep 09 '17 at 21:36

score 0 · Accepted Answer · answered Sep 13 '18 at 12:38

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

Save without overwriting current files

1 Answers1