Dealing with errors in Excel Save Macro

[tcombest]

I have a macro that will save a file to a particular directory with a date string attached to the end of the filename. It works great if there is no file with that name already in the target directory. But if the file does exist and you click that you don't want to overwrite, it sends you into the debug module.

There are two things I would like to know how to do.

1. Have the macro end if the file already exists so it won't go into the debug module.

2. After it saves the file, I would like to remain in the original spreadsheet and not have it put me in the newley named spreadsheet.

Here is my current code:

Sub test()
Dim strdate As String
strdate = Format(Now, "mm-dd-yyyy")
With ActiveWorkbook
.SaveAs "W:\Water Quality\Spreadsheets\Archived Data\Water Plant Operations Spreadsheet " & strdate & ".xlsm"
End With

End Sub


any help would be greatly appreciated.

 

[puru.sve]

Try this

Sub test()
Dim strdate As String
Dim strinf As String
Dim wk As Workbook
strdate = Format(Now, "mm-dd-yyyy")
With ActiveWorkbook
strinf = ThisWorkbook.Path & "\" & ThisWorkbook.Name
Currentfileame = "W:\Water Quality\Spreadsheets\Archived Data\Water Plant Operations Spreadsheet " & strdate & ".xlsm"
If Dir(Currentfileame) <> "" Then
Exit Sub
Else
.SaveAs Currentfileame
End If
Set wk = ActiveWorkbook
Workbooks.Open (strinf)
wk.Close
End With
Workbooks.Open (strinf)
err1:  MsgBox Err.Description
End Sub

 

[tcombest]

The code worked really well. One question,

If someone runs this macro more than once in the same day (by accident), it will see that a file with that name already exists in the target directory. Is there a way to have it pop up a dialog box and tell you that the file exists and do you want to overwrite or save with a new filename?

You've been a great help. Thank you.

 

[puru.sve]

use it // let me know

Sub test()
Dim strdate As String
Dim strinf As String
Dim wk As Workbook
strdate = Format(Now, "mm-dd-yyyy")
With ActiveWorkbook
    strinf = ThisWorkbook.Path & "\" & ThisWorkbook.Name
    Currentfileame = "K:\Purushottam\Water Plant Operations Spreadsheet " & strdate & ".xlsm"
    If Dir(Currentfileame) <> "" Then
        If MsgBox("This file is already exits in the desired folder.. " & vbLf & "Do you really want to replace", vbYesNo) = vbNo Then
            Exit Sub
        Else
            .SaveAs Currentfileame
        End If
    Else
        .SaveAs Currentfileame
    End If
    Set wk = ActiveWorkbook
    Workbooks.Open (strinf)
    wk.Close
End With
Workbooks.Open (strinf)
err1:  MsgBox Err.Description
End Sub

 

[tcombest]

It worked fine. I did a little editing to fine tune. Thanks very much.