Option Explicit
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim FD As FileDialog, FTyp As Long
Dim folderpath As String, MyWbName As String
Cancel = True
folderpath = Application.ActiveWorkbook.Path
MyWbName = Application.ActiveWorkbook.FullName
' reference a SaveAs Dialog
Set FD = Application.FileDialog(msoFileDialogSaveAs)
With FD
.FilterIndex = 3
.InitialFileName = MyWbName
.Title = "Save As"
End With
FD.Show
If FD.SelectedItems.Count = 0 Then
Exit Sub
Else
' check for proper extension
If Right(FD.SelectedItems(1), 4) = "xlsb" Then '= "xlsm" Then
FTyp = 50
Application.EnableEvents = False
Me.SaveAs FD.SelectedItems(1), FTyp
Application.EnableEvents = True
Else
MsgBox "selected wrong file format ... not saving"
End If
End If
End Sub