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

僤鯓⒐⒋嵵緔 提交于 2020-08-05 08:03:22

问题


I'm want users to be prompted to save a workbook before the VBA script starts modifying content. When the SaveAs dialog box comes up, if the user clicks Cancel I raise a custom error and stop the script. If they click Save and the filename already exists I want them to be asked whether to overwrite.

Here's my code:

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

If they click 'Yes', it overwrites it. If they click 'No', I want the SaveAs dialog box to come up so they can select a new filename, but instead I get an error. If they click 'Cancel', I want an error to occur and for the script to stop. The problem is I can't differentiate the errors triggered between 'No' and 'Cancel'.

Any suggestions how to handle this? (Please excuse any poor use of error handling - it's been a while.)

P.S. This function is called by another procedure so if the user clicks 'Cancel' at either the SaveAs dialog box or the ResolveConflict dialog, I would like the calling procedure to stop as well. I figure I can do this by checking what SaveCurrentWorkbook returns (either a Workbook object or False).


回答1:


You can simply create your own "overwrite?"-question like this:

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

As you have noticed, there is no difference between "No" and "Cancel" (for the application, because it will not stop the saving itself). Excel simply lies to itself saying: "I can't save here" and pops the same error for both cases... so the only real solution is to create your own msgbox :(




回答2:


I would make SaveCurrentWorkbook return True or False and use Msgboxes to handle the save as strNewFileName.

Then in the script that calls SaveCurrentWorkbook you can do a simple boolean evaluation.

    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

You don't need to set a reference when using SaveAs because your original is closed (without being saved )and your reference automatically updated to the new file. If you were using SaveCopyAs then your original file stays open and a copy of the current file (including any unsaved data) is made.

Notice in the test below that when we use SaveAs the refernce is updated to the SaveAs name. When we use SaveCopAs the name doesn't change because the original file is still open.



来源:https://stackoverflow.com/questions/38386511/how-to-handle-no-or-cancel-on-workbook-saveas-overwrite-confirmation

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!