Dialog box is appearing twice before saving

[LFKim2018]

I have written the SUB below - when I clicked [X] it is working all right - but the dialog box is appearing twice before saving. When I used the SAVE Icon - it does the same thing BUT there's a prompt that say "Excel has stop working" - when I ignore the prompt - it saves the file.

I am trying to save the file with a designated name.
Is this procedure even correct at all?
many many thanks

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim file_name As Variant
    Dim FName As String
    On Error Resume Next
    Application.DisplayAlerts = False
    nyr = Format(Sheets("FS").Range("A2"), "yyyy")
    nfty = " for the year " & nyr & ".xlsm"
    FName = Replace(ThisWorkbook.FullName, ".xlsm", "") & nfty
    If ExactWordInString(FName, " for the year ") <> 0 Then
        FName = Replace(ThisWorkbook.FullName, ".xlsm", "")
    End If
    file_name = Application.GetSaveAsFilename(FName, _
                FileFilter:="Excel Files,*.xlsm,All Files,*.*", _
                Title:="Save As File Name")
    If file_name = False Then
        Cancel = True
    Else
        If LCase$(Right$(file_name, 5)) <> ".xlsm" Then
            file_name = file_name & ".xlsm"
        End If
        ActiveWorkbook.SaveAs Filename:=file_name
    End If
    On Error GoTo 0
    Application.DisplayAlerts = True
    Application.Quit
End Sub

Function ExactWordInString(Text As String, Word As String) As Boolean
    ExactWordInString = " " & UCase(Text) & " " Like "*[!A-Z]" & UCase(Word) & "[!A-Z]*"
End Function

 

[LFKim2018]

I have tested the SUB so many times - it worked perfect for [X] ..
I tested to save it with its original name - IT WORKED also .. no prompt "Excel stopped working".
the only problem is when I saved it with a designated name - the prompt keeps appearing!
although when ignored - it saved the file anyway.
Anybody? MVPs? who can solve the reason causing this prompt?
before this thread gets buried under a ton of threads and went into oblivion..
MANY MANY THANKS

 

[LFKim2018]

Context of the prompt "Excel stopped working"


Problem signature:
Problem Event Name: BEX
Application Name: EXCEL.EXE
Application Version: 15.0.4420.1017
Application Timestamp: 50673286
Fault Module Name: unknown
Fault Module Version: 0.0.0.0
Fault Module Timestamp: 00000000
Exception Offset: c8e8e84d
Exception Code: c0000005
Exception Data: 00000008
OS Version: 6.1.7601.2.1.0.256.1
Locale ID: 1033


Additional information about the problem:
LCID: 1033
skulcid: 1033


Read our privacy statement online:
http://go.microsoft.com/fwlink/?linkid=104288&clcid=0x0409


If the online privacy statement is not available, please read our privacy statement offline:
C:\Windows\system32\en-US\erofflps.txt