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