Macro to force save as

[archie00]

OK...this I've managed to create a macro that does the following:
- If the file type is xlsm, only allow the user to save as an xlsm
- If the file type is any other type (this will only be xltm), prompt for a password;
- If the password is correct, allow the user to save as any file type (I will be the only person who knows the password);
- If the password is incorrect, only allow the user to save as an xlsm

This basically means that if the user opens the template, they can only save as an xlsm, but if they've already saved it as an xlsm, no password input box pops up when they go to save it.

The code is as follows:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.Calculate
Dim fName As String

If Sheets("File Information").Range("A4").Value = "xlsm" Then
fName = Application.GetSaveAsFilename(, "Excel Macro-Enabled Workbook (*.xlsm), *.xlsm")
If fName = "False" Then
    MsgBox "You pressed cancel", vbOKOnly
    Cancel = True
Exit Sub
Else
Application.EnableEvents = False
    ThisWorkbook.SaveAs Filename:=fName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
    Application.EnableEvents = True
End If

Else
Dim MyPassword
MyPassword = InputBox("Please enter password", "Password Prompt", "********")

'hardcode password
If MyPassword = "bpscortum" Then
MsgBox "Access Granted", vbInformation, "Access"
'call macro
Application.Dialogs(xlDialogSaveAs).Show
GoTo Finish:
Else
fName = Application.GetSaveAsFilename(, "Excel Macro-Enabled Workbook (*.xlsm), *.xlsm")
If fName = "False" Then
    MsgBox "You pressed cancel", vbOKOnly
    Cancel = True
Exit Sub
Else
Application.EnableEvents = False
    ThisWorkbook.SaveAs Filename:=fName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
    Application.EnableEvents = True
    
End If
End If
End If
Finish:
Application.Calculate
End Sub

Where Range("A4") contains a formula that works out the file type (using cell function). So basically the whole macro works beautifully when it's not a Private Sub and doesn't have the (ByVal SaveAsUI As Boolean, Cancel As Boolean) bit at the end. So when I press play in the VBA editor it works smoothly and if I assigned it to a button in my spreadsheet it would work beautifully...but when I make it work automatically it seems to shut excel down (i.e. cause it to freeze). It also seems to request me to enter the password twice.

Any help?