Private Sub Workbook_BeforeSave _
(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'This macro prevents saving the excel file (workbook) under a
'different name.
'However, the file can be saved in a different location, but
'still under the same file name.
'
'This MUST be placed in "ThisWorkbook" and NOT in a Module.
'
Dim NamePath As String
Dim strName As String
Dim lFind As Long
If SaveAsUI = True Then
Cancel = True
With Application
.EnableEvents = False
NamePath = .GetSaveAsFilename
strName = Mid(NamePath, InStrRev(NamePath, "\", -1, vbTextCompare) + 1, 256)
If NamePath = "False" Then
.EnableEvents = True
Exit Sub
ElseIf strName <> Me.Name Then
MsgBox "You cannot save as another name"
.EnableEvents = True
Exit Sub
Else
Me.SaveAs NamePath
.EnableEvents = True
End If
End With
End If
End Sub