如果文件已经打开，errorhandeling 不适用于 SaveAs

Question

我有一个小代码需要在关闭 excel 文件时运行。

文件需要制作一个只读的副本，以便可以同时修改原始文件。

如果只读副本关闭，这部分工作，但当副本打开时，我收到运行时间错误：如果文件在另一台设备上打开，则无法保存。到目前为止，我处理错误的尝试没有奏效。有谁知道我是否以及如何“忽略”这个错误？

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

您将永远无法保存覆盖打开的工作簿。所以，你必须初步检查是否有同名工作簿打开，如果有，关闭并保存。请尝试下一种方式：

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

Answer 2

在 FaneDuru 的帮助下以及我在其他地方找到的一些东西，这就是我现在使用的东西：

Private Sub Workbook_BeforeClose(Cancel As Boolean)


If ThisWorkbook.Saved = False Then

Dim answer As Integer
 
answer = MsgBox("Do you want to save? ", vbQuestion + vbYesNo + vbDefaultButton2, "Save file?")

If answer = vbYes Then
  ThisWorkbook.Save
  GoTo 4
Else
GoTo 3
End If

3 ThisWorkbook.Saved = True
Application.Quit

ElseIf ThisWorkbook.Saved = True Then


4 Application.DisplayAlerts = False

Application.ScreenUpdating = False

ThisWorkbook.SaveAs FileName:="file123- backup", FileFormat:=xlWorkbookDefault, Password:="****"

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



Dim FilePath As String
FilePath = IsWBOpen("file123- readonly.xlsx")
If FilePath = True Then
2 Application.Quit
Exit Sub
Else
On Error GoTo 2

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

 End If

Application.ScreenUpdating = True

Application.DisplayAlerts = True

Application.Quit

End If


Exit Sub
End Sub

Function IsWBOpen(FileName As String)
'declare variables
Dim FileNo As Long
Dim ErrorNo As Long
On Error Resume Next
FileNo = FreeFile()
On Error Resume Next
Open FileName For Input Lock Read As #FileNo
Close FileNo
ErrorNo = Err
On Error GoTo 0
Select Case ErrorNo
Case 0
IsWBOpen = False
Case 70
IsWBOpen = True
Case Else
Error ErrorNo
End Select
End Function

如果文件已经打开，errorhandeling 不适用于 SaveAs

errorhandeling does not work on SaveAs if file already open

excel

vba

save