问题
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