Save File As Macro causes error if existing file is already open

Try like this

Here's one way of checking for the existence of the file and automatically implementing a numeric counter to append on the end (ie so no duplicates):

http://www.mrexcel.com/forum/showthread.php?t=560710&highlight=exit

VoG said:

Try like this

Code:

Sub SaveFileAs()

Dim file As String

file = "ClientData_" & Format(Now, "ddmmmyy") & ".xls"
If BookOpen(file) Then
    MsgBox "Please close " & file & " before running this", vbInformation
    Exit Sub
End If
ActiveWorkbook.SaveAs file

End Sub



Function BookOpen(wbName As String) As Boolean
On Error Resume Next
BookOpen = Len(Workbooks(wbName).Name)
End Function

Click to expand...

That's excellent thank you and works brilliantly.

One final question if you could help.

The 'save as' element of the macro is actually part of a longer macro which formats the file removing buttons etc before finally saving the file. Is there a way of positioning the check (to see if there is another document open with the same name) at the top of the larger macro so it asks the user to close the other open file before the other changes are made? Here is the full macro below.

Sub save_as_Client()

' Keyboard Shortcut: Ctrl+o

Sheets("Titles").Select
ActiveWindow.SelectedSheets.Visible = False
Sheets("ClienteSolicitar").Select
ActiveSheet.Shapes("Clean_Button").Select
Selection.Cut
ActiveSheet.Shapes("Import_Button").Select
Selection.Cut
ActiveSheet.Shapes("Format_Button").Select
Selection.Cut
ActiveSheet.Shapes("NoCliente_Button").Select
Selection.Cut
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Range("A1").Select
Sheets("NoClienteSolicitar").Select
ActiveSheet.Shapes("CleanNo_Button").Select
Selection.Cut
ActiveSheet.Shapes("ImportNo_Button").Select
Selection.Cut
ActiveSheet.Shapes("FormatNo_Button").Select
Selection.Cut
ActiveSheet.Shapes("SaveNo_Button").Select
Selection.Cut
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Range("A1").Select

Dim file As String

file = "ClientData_" & Format(Now, "ddmmmyy") & ".xls"
ActiveWorkbook.SaveAs file

End Sub

Many thanks again for your assistance

Try this

That's fantastic and does exactly what I need it to do. Thanks again for your help.

Richard Schollar said:

Here's one way of checking for the existence of the file and automatically implementing a numeric counter to append on the end (ie so no duplicates):

http://www.mrexcel.com/forum/showthread.php?t=560710&highlight=exit

Click to expand...

Thanks Richard - that's a great link which I've bookmarked, although I now don't need it for this task, it will come in use for later I'm certain. Thank you.