errorhandeling does not work on SaveAs if file already open

Question

I have a small code that needs to run when closing the excel file.

the file needs to make a copy that is read only so that the original can be amended at the same time.

this part works if the readonly copy is closed but when the copy is open I get a runtime error: cannot save if file is open on another device. So far my attempts to handle the error have not worked. Does anyone know if and how I can "ignore" this error?

Sub createcopy()

Application.DisplayAlerts = False

Application.ScreenUpdating = False

Dim ws As Worksheet
For Each ws In Worksheets
    ws.Protect Password:="", AllowFiltering:=True, AllowSorting:=True
Next ws

On Error GoTo 2
ThisWorkbook.SaveAs Filename:="file123-readonly", FileFormat:=xlWorkbookDefault, Password:=""
On Error GoTo 2


Application.ScreenUpdating = True

Application.DisplayAlerts = True

2 Application.Quit

Exit Sub
End Sub

Answer 1

You will never be able to save overwriting an open workbook. So, you must preliminarily check if a workbook with the same name is open, if so, close it and save it after. Please, try the next way:

Sub createcopy()
Application.DisplayAlerts = False
Application.ScreenUpdating = False

Dim ws As Worksheet, wbName As String
For Each ws In Worksheets
    ws.Protect password:="", AllowFiltering:=True, AllowSorting:=True
Next ws

wbName = "file123-readonly.xlsx" 'full workbook name
                                 'If without extension, it must be added (inside the string or in code)
If isWbOpen(wbName) Then
    Workbooks(Split(wbName, "\")(UBound(Split(wbName, "\")))).Close , False
End If

ThisWorkbook.saveas fileName:=wbName, FileFormat:=xlWorkbookDefault, password:=""
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub