Search code examples
excelvbasavepdf-generationsavefiledialog

Save without overwriting current files


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

Solution

  • 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