Solved: Canceling a BeforeSave Event

[Opv]

I am attempting to create a BeforeSave event that allows me to cancel the standard system save and substitute my own script. The following has been placed in the "This Workbook" module.


Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Cancel = True

Application.DisplayAlerts = False
Dim tempName As String
Dim newName As String

With Sheets("(History)")
tempName = ActiveWorkbook.Name
newName = .Range("A1").Value & ", E and E Farm Goat Log.xls"

If tempName = newName Then
ThisWorkbook.Save
Exit Sub
Else
ActiveWorkbook.SaveAs Filename:=newName
If Dir(tempName) <> "" Then Kill tempName
End If

End With

Application.DisplayAlerts = True

End Sub


Something in the above code is causing the file not to be saved. Any thoughts?

[frank_m]

I believe you need to set cancel = true at the end, rather than the beginning of your code.

I may be wrong but I believe that a comma is not a legal file name character.

As far as I know Kill should not be used with this.

I was not able to figure out how to avoid it, but I really dislike running the command Application.EnableEvents = False because if there is a problem before it gets set back to true, the before save event will not fire the next time you run it. You really should incorporate some sort of error trapping or other code to accommodate for that issue.

This seems to work, but I did not test it as thoroughly as it should be.
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Application.EnableEvents = False

Application.DisplayAlerts = False
Dim tempName As String
Dim newName As String

With Me.Sheets("Sheet1") ' Change to your sheet name
tempName = Me.Name
newName = .Range("A1").Value & " E and E Farm Goat Log.xls"

If tempName = newName Then
Me.Save
Exit Sub
Else
Me.SaveAs Filename:=newName
End If

End With

Application.DisplayAlerts = True

Application.EnableEvents = True

Cancel = True

End Sub

[frank_m]

Best that you wait to get some explainations, or code, from an Expert, as I'm not one.

When I first was trying to use the kill command, it was crashing Excel

I over came that by adding, Application.ScreenUpdating = False, and of course setting it back to True at the end. - Unfortunately I do not understand why that was the cure, or if it is a good cure.

Here's the code I came up with in case you want to experiment with it.
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Dim tempName As String
Dim newName As String

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False

tempName = Me.Name

With Me.Sheets("Sheet1") ' Change to your sheet name
newName = .Range("A1").Value & " E and E Farm Goat Log.xls"
End With

If tempName = newName Then
Me.Save
Exit Sub
Else
Me.SaveAs Filename:=newName
On Error Resume Next
If Dir(tempName) <> "" Then Kill tempName
On Error GoTo 0
End If

Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True

Cancel = True

End Sub

[frank_m]

Fiddled with it more and found that using DoEvents, as shown below, seems to be as good, probably better than turning off ScreenUpdating. At least that makes some sence to me.
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Dim tempName As String
Dim newName As String

Application.EnableEvents = False
Application.DisplayAlerts = False

tempName = Me.Name

With Me.Sheets("Sheet1") ' Change to your sheet name
newName = .Range("A1").Value & " E and E Farm Goat Log.xls"
End With

If tempName = newName Then
Me.Save
Exit Sub
Else
Me.SaveAs Filename:=newName
DoEvents
On Error Resume Next
If Dir(tempName) <> "" Then Kill tempName
On Error GoTo 0
End If

Application.DisplayAlerts = True
Application.EnableEvents = True

Cancel = True

End Sub

[Opv]

Thanks for the suggestions. I'm having trouble getting the suggested code to work. It appears to go through the motions of saving but it does not appear to be saving the file as a new file if the content of .Range("A1") has changed.

Expounding a bit on my original post, I have substantially similar code that does precisely what I want when run from a button on a user-defined menu. Said button calls the following script:


Sub saveChanges()

Application.DisplayAlerts = False
Dim tempName As String
Dim newName As String

With Sheets("(History)")
tempName = ActiveWorkbook.Name
newName = .Range("A1").Value & ", E and E Farm Goat Log.xls"

If tempName = newName Then
ThisWorkbook.Save
Exit Sub
Else
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & newName
If Dir(tempName) <> "" Then Kill tempName
End If

End With

Application.DisplayAlerts = True

End Sub



This script tests to see if the content of Range("A1") has changed (i.e., the version number and the date of the most recent VBA changes). If the version/date has not changed, t simply saves the current changes made to the sheet. However, if their is a new version/date, the script saves the file so that the new file name includes the new version/date information and then deletes the original file.

The purpose of my original post was to see if there is a way to achieve the above in the event a user happens to click on the system "Save" button in the main program menu rather than clicking on the button in the user-defined menu. I thought I could start with the existing code since it is doing what I want when run from the user-defined menu. I was hoping all I had to do was plug it in the "BeforeSave" subroutine and then cancel the regular save function. Alas, that does not appear to be working.

[GTO]

Try:


Option Explicit

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim strTempName As String
Dim strNewName As String
Dim strPath As String
Static bolInProcess As Boolean

If SaveAsUI Then
MsgBox "Sorry, SaveAs not allowed...", 0, vbNullString
Cancel = True
Exit Sub
End If

If Not bolInProcess Then
'// Set a flag, similar to outcome of EnableEvents, but we're not worried about //
'// failing code. //
bolInProcess = True
'// You might want to specify the Path, rather than depend on whatever the //
'// CurDir is. //
strPath = ThisWorkbook.Path & "\"
strTempName = ThisWorkbook.Name
'// A comma is actually okay. //
strNewName = _
ThisWorkbook.Worksheets("Sheet1").Range("A1").Value & _
", E and E Farm Goat Log.xls"

If strTempName = strNewName Then
ThisWorkbook.Save
Else
'// Handle if there's already a file w/same name as what we are trying to //
'// SaveAs. //
If CreateObject("Scripting.FileSystemObject") _
.FileExists(strPath & strNewName) Then

Select Case MsgBox("A file with this name already exists. Do you" & _
vbCrLf & "want to overwrite it?", _
vbCritical + vbYesNo, _
vbNullString)
Case vbYes
'// User selected <Yes>, so kill alerts, overwrite, then do the //
'// stuff past the IF we're in. //
Application.DisplayAlerts = False
ThisWorkbook.SaveAs strPath & strNewName
Application.DisplayAlerts = True
Case Else
'// Else, Cancel the original Save, reset the flag and bail. /
Cancel = True
bolInProcess = False
Exit Sub
End Select
Else
ThisWorkbook.SaveAs strPath & strNewName
End If
DoEvents
On Error Resume Next
Kill strPath & strTempName
On Error GoTo 0
End If
Cancel = True
'// reset the flag, for next time user saves. //
bolInProcess = False
End If
End Sub

[Opv]

That did the trick. Thanks!

Opv