VBA - Error handling for when file "save as" is No or Cancel

[netrixuser]

Hello,

Although my code works I am trying, gradually, to make it more efficient, and I am at the stage where I want to do something if, during the File "save as" command, the user does not want to overwrite an existing file or presses cancel.

My code for saving the workbook is:

        FPath = "C:\Users\" & Environ$("UserName") & "\Downloads"
        FName = Sheets("Index").Range("A104").Text
        ThisWorkbook.SaveAs Filename:=FPath & "\" & FName

In cell A104 on the Index sheet I have a concatenation of a couple of cells to produce the text "(Current Month)-(Current Year) <current month=""><current year="">Monthly MRL Reconciliation"
Today that produces Apr-2019 Monthly MRL Reconciliation and, without my intervention, it saves it with an xlsm extension

If, at the file save as prompt, there is already a file existing with the same name I get a popup saying as much, if No or Cancel is selected the code crashes with:

Run-time error '1004'
Method 'SaveAs' of Object'_Workbook' failed​

I found a post regarding this on the site and have now added some code to stop it crashing, but I would like to be able to give the user the options of:

1) cancelling the save as and finishing the script -which is what the extra code below does
2) saying No to the overwrite question, and being prompted to change the filename - which I am struggling with tbh.​

The code to stop the script crashing when either No or Cancel is selected is

Sub Get_Reports()[INDENT]On error GoTo EH1

'My Code


[/INDENT]
[INDENT]EH1:[/INDENT]

End Sub

I now need assistance to write some "stuff" after EH1:

Any help gratefully received !!

Regards

Netrix</current></current>

 

[nemmi69]

Does this help?

Option Explicit
Dim FPath As String
Dim FName As String


Sub SaveTheFile()
 FPath = "C:\Users\" & Environ$("UserName") & "\Downloads"
 FName = Sheets("Index").Range("A104").Text
 Application.EnableEvents = False
 On Error GoTo NoSave
 ThisWorkbook.SaveAs Filename:=FPath & "\" & FName
 Exit Sub
 
NoSave:
Application.EnableEvents = True
MsgBox "Cannot save as File " & FName & " already open."
On Error GoTo 0
End Sub

 

[netrixuser]

Does this help?

Option Explicit
Dim FPath As String
Dim FName As String


Sub SaveTheFile()
 FPath = "C:\Users\" & Environ$("UserName") & "\Downloads"
 FName = Sheets("Index").Range("A104").Text
 Application.EnableEvents = False
 On Error GoTo NoSave
 ThisWorkbook.SaveAs Filename:=FPath & "\" & FName
 Exit Sub
 
NoSave:
Application.EnableEvents = True
MsgBox "Cannot save as File " & FName & " already open."
On Error GoTo 0
End Sub

Hi nemmi69, thank you for your reply, it works in that it will tell the user that the file already exists so cannot be saved (I changed the text slightly) without crashing. But I would prefer this to happen if Cancel was selected. If the user chose "No" to the prompt when trying to Save the File As a file that already existed, I would like them to have the option to change the name (ie be prompted to do so rather than to do something after the script has ended)

Is that doable ?

Kind regards

Netrixuser

 

[nemmi69]

This better?

Option Explicit
Dim FPath As String
Dim FName As String
Dim NewFilename As String
Dim Answer As Variant


Sub SaveTheFile()
 FPath = "C:\Users\" & Environ$("UserName") & "\Downloads"
 FName = Sheets("Index").Range("A104").Text
 Application.EnableEvents = False
 On Error GoTo NoSave
 ThisWorkbook.SaveAs Filename:=FPath & "\" & FName
 Exit Sub
 
NoSave:
On Error GoTo 0
Application.EnableEvents = True
Answer = MsgBox("Cannot save as File " & FName & " already open." & _
            Chr$(13) & "Do you wish to enter a new filename?", vbYesNo, ThisWorkbook.Name)


 If Answer = vbNo Then
        'Code for No button Press
        MsgBox "You pressed NO!"
    Else
        'Code for Yes button Press
        NewFilename = InputBox("Please enter new filename", _
         "filename", "Type your filename here")
        If NewFilename <> "" Then
            FName = NewFilename
            Resume
        End If


    End If
End Sub

 

[netrixuser]

Many thanks nemmi69, and apologies for taking over a year to respond !!!! (My job spec changed and I didn't get to finish the VBA project I was working on)

 

[nemmi69]

Cheers, happens to us all