Question

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

这是我的代码：

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

如果他们点击“是”＆＃39;，则会覆盖它。如果他们单击“否”，我希望SaveAs对话框出现，以便他们可以选择新的文件名，但我得到一个错误。如果他们点击“取消”，我希望发生错误并让脚本停止。问题是我无法区分“否”之间触发的错误。和＆＃39;取消＆＃39;。

有任何建议如何处理？（请原谅任何糟糕的错误处理用法 - 它已经有一段时间了。）

P.S。此功能由另一个程序调用，因此如果用户点击“取消”＆＃39;在SaveAs对话框或ResolveConflict对话框中，我希望调用过程也停止。我想通过检查SaveCurrentWorkbook返回的内容（Workbook对象或False）可以做到这一点。

Answer 1

你可以简单地创建自己的“覆盖？” - 这样的问题：

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

正如您所注意到的，“否”和“取消”之间没有区别（对于应用程序，因为它不会停止保存本身）。 Excel只是谎称自己说：“我无法保存在这里”并且在两种情况下都会弹出相同的错误...所以唯一真正的解决方案就是创建自己的msgbox :(

Answer 2

我会使SaveCurrentWorkbook返回True或False并使用Msgboxes将save保存为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

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

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

如何处理＆＃39;否＆＃39;或者＆＃39;取消＆＃39;在Workbook.SaveAs覆盖确认？

2 个答案: