Private Sub Workbook_BeforeClose(cancel As Boolean)
    
    On Error Resume Next
    Application.DisplayAlerts = False
    
    Dim thisPath As String  'For obtaining path of this file
    Dim FileDate As String  'For date and time to make a new file name
    Dim NewFileName As String   'For new name
    
    thisPath = ThisWorkbook.Path
    FileDate = Format(Now, "yyyymmdd-hhnn")
    
    Dim OriginalFileName As String
    OriginalFileName = ThisWorkbook.Name
    
    Dim Pos As Integer
    Pos = InStr(OriginalFileName, ".")
    
    NewFileName = Left(OriginalFileName, Pos - 1)
  
    NewFileName = NewFileName & "_bkup" & FileDate
        
    'Check if 99_Backup folder exists
    Dim result
    Dim backup_dir
    backup_dir = thisPath & "\99_Backup"
    result = Dir(backup_dir, vbDirectory)
    If result = "" Then
        'Not exist, so create
        MkDir backup_dir
    End If
        
    'Saving this foder as the new name
    ThisWorkbook.SaveAs Filename:=thisPath & "\99_Backup\" & NewFileName, FileFormat:=xlOpenXMLWorkbook

    Application.DisplayAlerts = True

End Sub