VBA -- Don't allow user to change file name on saveas

[winglessbuzzard]

I have a large group of files and people using the files seem fond of renaming the files and changing the extension (.xlsm --> .xlsb..). I want to keep this from happening.

The users should be able to move the files wherever they want (other directories..etc), but not change the file name while in excel (I know they could still right-click the file and rename it from the file explorer... I'll leave that issue alone for now.)

my bad attempt at this:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim mywb As String

mywb = ThisWorkbook.Name

ThisWorkbook.SaveAs mywb

End Sub

... the above code doesn't quite get to what I'm trying... it saves the file as soon as the saveas dialog box opens, lets you rename the file and save it again anywhere with any new name/extension.

Just to be clear, all I'm trying to do is force the user to keep the original file name and extension while also allowing them to save the file in a different directory.

 

[winglessbuzzard]

just forcing the user to keep the file extension would be nice also... this code works:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
     
    Dim varWorkbookName As String
    Dim FileFormatValue As Integer
     
    On Error GoTo Quit
    Application.EnableEvents = False
     
    If SaveAsUI = True Then
        varWorkbookName = Application.GetSaveAsFilename( _
        fileFilter:="Excel Macro Enabled Workbook (*.xlsm), *.xlsm")
        Cancel = True
         
        If varWorkbookName <> "False" Then
            Select Case LCase(Right(varWorkbookName, Len(varWorkbookName) - InStrRev(varWorkbookName, ".", , 1)))
            Case "xlsm": FileFormatValue = 52
            End Select
             
            ActiveWorkbook.SaveAs varWorkbookName
        End If
    End If
     
Quit:
     
    If Err.Number > 0 Then
        If Err.Number <> 1004 Then
             
            MsgBox "Error: " & Err.Number & Err.Description & vbCrLf & vbCrLf & vbCrLf & _
            "Title", vbCritical
             
        End If
    End If
     
    Application.EnableEvents = True
     
End Sub