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

[yorkshirelad]

I have a macro that automates the saving of a master file with a new version with today's date.

Sub SaveFileAs()

Dim file As String

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

End Sub

If there is already an existing file I get the standard Windows warning asking if I want to overwrite the existing file - which is great.

However ....

If a file with the same name is already open the macro comes up with a Run-time error '1004'

"You cannot save this workbook with the same name as another open workbook or add-in. Choose a different name etc."

Apart from the confusion caused to the user seeing the macro error message. As this also means that the master file is still open with all the changes - which risks being overwritten (if the user clicks to save this file). Is there a way of the file being saved with an alternative filename e.g. Version1 etc - if another copy of the file is already open?

The other option would be if there was a macro that checked for a file already being open with the same name and if so asked them to close it, before they clicked the final save file macro.

Many thanks for any assistance provided - thanks

 

[VoG]

Try like this

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

 

[Richard Schollar]

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

 

[yorkshirelad]

Try like this

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

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

 

[VoG]

Try this

Sub save_as_Client()

' Keyboard Shortcut: Ctrl+o
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

Sheets("Titles").Visible = False
With Sheets("ClienteSolicitar")
    .Shapes("Clean_Button").Delete
    .Shapes("Import_Button").Delete
    .Shapes("Format_Button").Delete
    .Shapes("NoCliente_Button").Delete
    .Rows(1).Delete
End With
With Sheets("NoClienteSolicitar")
    .Shapes("CleanNo_Button").Delete
    .Shapes("ImportNo_Button").Delete
    .Shapes("FormatNo_Button").Delete
    .Shapes("SaveNo_Button").Delete
    .Rows(1).Delete
End With

ActiveWorkbook.SaveAs file

End Sub



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

 

[yorkshirelad]

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

 

[yorkshirelad]

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

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.