如何在 Workbook.SaveAs 覆盖确认时处理 'No' 或 'Cancel'？

Question

我希望在 VBA 脚本开始修改内容之前提示用户保存工作簿。当“另存为”对话框出现时，如果用户单击“取消”，我将引发自定义错误并停止脚本。如果他们单击“保存”并且文件名已经存在，我希望他们被询问是否覆盖。

这是我的代码：

Function SaveCurrentWorkbook(wkbSource As Workbook, strNewFileName As String) As Variant
    If Not bolDebug Then On Error GoTo errHandler
    Dim varSaveName As Variant

SaveAsDialog:
    varSaveName = Application.GetSaveAsFilename(InitialFileName:=strNewFileName, FileFilter:="Excel Files (*.xls), *.xls")
    If varSaveName <> False Then
        wkbSource.SaveAs Filename:=varSaveName, ConflictResolution:=True, Addtomru:=True
        Set SaveCurrentWorkbook = wkbSource
    Else
        SaveCurrentWorkbook = False
        Err.Raise 11111, , "Save Canceled"
    End If

exitProc:
    Exit Function

errHandler:
    Select Case Err.Number
        Case 1004 'Clicked "No" or "Cancel" - can't differentiate
            Resume SaveAsDialog
        Case esle
            MsgBox "File not saved. Stopping script.", vbOKOnly, Err.Description
            Resume exitProc
    End select

End Function

如果他们点击 'Yes'，它会覆盖它。如果他们单击 'No'，我希望出现“另存为”对话框，以便他们可以 select 一个新文件名，但我却收到错误消息。如果他们单击 'Cancel'，我希望发生错误并停止脚本。问题是我无法区分 'No' 和 'Cancel' 之间触发的错误。

有什么处理方法的建议吗？（请原谅任何错误处理的不当使用 - 已经有一段时间了。）

P.S。此函数由另一个过程调用，因此如果用户在 SaveAs 对话框或 ResolveConflict 对话框中单击 'Cancel'，我希望调用过程也停止。我想我可以通过检查 SaveCurrentWorkbook returns（Workbook 对象或 False）来做到这一点。

Answer 1

我会让 SaveCurrentWorkbook return 为 True 或 False 并使用 Msgboxes 处理保存为 strNewFileName。

然后在调用 SaveCurrentWorkbook 的脚本中，您可以进行简单的布尔计算。

    If SaveCurrentWorkbook(wkbSource, "C:\...\SomeFile.xls") then
       'Do Something
    Else
       'Do Something else
    End If

Function SaveCurrentWorkbook(wkbSource As Workbook, strNewFileName As String) As Boolean
    Dim iResult As VbMsgBoxResult

    Dim varSaveName As Variant

    If Dir(strNewFileName) <> "" Then
        iResult = MsgBox("Press [Yes] to overwite " & strNewFileName & " or [No] to choose a new filename.", vbInformation + vbYesNo, "Save File")
    Else
        iResult = MsgBox("Press [Yes] to save as " & strNewFileName & " or [No] to choose a new filename.", vbInformation + vbYesNo, "Save File")
    End If

    If iResult = vbYes Then
        SaveCurrentWorkbook = True
    Else
        varSaveName = Application.GetSaveAsFilename(FileFilter:="Excel Files (*.xls), *.xls")
        If CStr(varSaveName) <> "False" Then
            wkbSource.SaveAs Filename:=varSaveName, ConflictResolution:=True, Addtomru:=True
            SaveCurrentWorkbook = True
        End If
    End If

End Function

使用另存为时不需要设置引用，因为您的原始文件已关闭（未保存）并且您的引用会自动更新到新文件。如果您使用的是 SaveCopyAs，那么您的原始文件将保持打开状态，并制作当前文件（包括任何未保存的数据）的副本。

请注意在下面的测试中，当我们使用 SaveAs 时，引用会更新为 SaveAs 名称。当我们使用 SaveCopAs 时，名称不会改变，因为原始文件仍然打开。

Answer 2

您可以像这样简单地创建自己的 "overwrite?"-问题：

Function SaveCurrentWorkbook(wkbSource As Workbook, strNewFileName As String) As Variant
    If Not bolDebug Then On Error GoTo errHandler
    Dim varSaveName As Variant

SaveAsDialog:

    varSaveName = Application.GetSaveAsFilename(InitialFileName:=strNewFileName, FileFilter:="Excel Files (*.xls), *.xls")
    If varSaveName <> False Then
      If Len(Dir(varSaveName)) Then 'checks if the file already exists
        Select Case MsgBox("A file named '" & varSaveName & "' already exists at this location. Do you want to replace it?", vbYesNoCancel + vbInformation)
        Case vbYes
          'want to overwrite
          Application.DisplayAlerts = False
          wkbSource.SaveAs varSaveName, ConflictResolution:=2, Addtomru:=True
          Application.DisplayAlerts = True
          Set SaveCurrentWorkbook = wkbSource
        Case vbNo
          GoTo SaveAsDialog
        Case vbCancel
          SaveCurrentWorkbook = False
          Err.Raise 11111, , "Save Canceled"
        End Select
      Else
        wkbSource.SaveAs varSaveName, ConflictResolution:=True, Addtomru:=True
        Set SaveCurrentWorkbook = wkbSource
      End If
    Else
      SaveCurrentWorkbook = False
      Err.Raise 11111, , "Save Canceled"
    End If

exitProc:
    Exit Function

errHandler:
    Select Case Err.Number
    Case 1004 'Clicked "No" or "Cancel" - can't differentiate
      Resume SaveAsDialog
    Case Else
      MsgBox "File not saved. Stopping script.", vbOKOnly, Err.Description
      Resume exitProc
    End Select

End Function

如您所见，"No" 和 "Cancel" 之间没有区别（对于应用程序，因为它不会自行停止保存）。 Excel 只是自欺欺人地说："I can't save here" 并在两种情况下弹出相同的错误...所以唯一真正的解决方案是创建自己的 msgbox :(

如何在 Workbook.SaveAs 覆盖确认时处理 'No' 或 'Cancel'？

How to handle 'No' or 'Cancel' on Workbook.SaveAs overwrite confirmation?

excel

vba

excel-2013