How to add error handling that will advise the user if the file name already exists AND offer the user the option to overwrite the file (or not

How to add error handling that will advise user if file name already exists AND offer user option to overwrite file

Requirement:

To add error handling that will advise the user if the file name already exists AND offer the user the option to overwrite the file (or not).

Solution:

Excel will automatically display a message if a file already exists and asks if you want to replace when trying to save it. The "Application.DisplayAlerts = False" statement prevents the warning from popping up. If you remove that line of code, it should take care of your problem.

Code:

Sub Save_WeeklyFile()
    Dim fName As String         ' Output File Name
    Dim Path1 As String         ' Path name (current directory)
    Dim xlD As Workbook         ' Output file
    Dim xlS As Workbook         ' THIS workbook
    Dim shS As Worksheet        ' Worksheets in current workbook
   
    ' Optimize Macro Speed
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With
    ' Format to Generate Dynamic Name based on variables on sheet (Data)
        ' Sheet Name where every variables located:  data
            ' File Name:  C3
            ' Week #:  J3
            ' Period Ending:  R3
   
    Path1 = ThisWorkbook.Path
    fName = Sheets("Main").Range("C3").Value & " - Week #" & Range("J3").Value & " - Period Ending " & Format(Range("R3").Value, "mm-dd-yy") & ".xlsx"
    Set xlS = ThisWorkbook
    
    ' Create the new workbook
    Set xlD = Workbooks.Add
   
    ' Copy sheets in
    For Each shS In xlS.Sheets
        If shS.Name <> "Main" Then
            shS.Copy after:=xlD.Sheets(Sheets.Count)
            xlD.Sheets(Sheets.Count).Name = shS.Name
        End If
    Next shS
   
    ' Remove the superfluous sheets
    Application.DisplayAlerts = False
    xlD.Sheets(1).Delete ' <!-- Removes sheet1 (Main)
    Application.DisplayAlerts = True
      
    ' Hide the code sheet
    xlD.Sheets("codes").Visible = xlHidden
    xlD.Sheets("Improvements").Visible = xlHidden
       
    ' Save the workbook
    xlD.SaveAs Filename:=Path1 & "\" & fName, FileFormat:=51
   
    'Close the workbook
    xlD.Save
   
    ' Reset Macro Optimization Settings
    With Application
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
    xlS.Close True ' <!--- ' THIS workbook
End Sub

Obtained from the OzGrid Help Forum.

Solution provided by Mumps.