workbook_beforesave event not firing

Question

I have a VBA Code which forced the save as dialog box to show the default save as type as xlsm while trying to save a xltm. Please check out the attached code and correct me if code is incorrect

Application.EnableEvents = False 
Application.DisplayAlerts = False 
If SaveAsUI = True Then 
    bInProcess = True 
'The following statements shows the save as dialog box with default path
    Set FileSaveName = Application.FileDialog(msoFileDialogSaveAs)
    FileSaveName.InitialFileName = ThisWorkbook.Name
    FileSaveName.FilterIndex = 2   'select to save with a ".xlsm" extension
    FileSaveName.Title = "Save As"
    intchoice = FileSaveName.Show
    If intchoice = 0 Then
    Else
        FileSaveName.Execute
    End If
Else 'Normal Save 
    bInProcess = True 
    Cancel = True
    ThisWorkbook.Save 
End If
Application.EnableEvents = True
Application.DisplayAlerts = True

The above code works fine while trying to save using (ctrl+s). If I tried to close through excel close window option. Excel shows default save-as pop-up. If I click "Save" option from that save as pop-up , workbook_beforesave event is not invoked(Save As dialog is shown with default data type changed to xls from xlsm). I don't know what mistake I made? Please help me to get rid of this..

Thanks in advance!!!

Answer 1

You need to place your code between these lines

Private Sub Workbook_BeforeClose(Cancel As Boolean)

End Sub

Answer 2

After re-reading and some more testing I understand that the code in your question is already in the Workbook_BeforeSave event you created. The first answer you got was actually in the right direction, you need to put extra code in the Workbook_BeforeClose event to handle the top right X.

What you want is a really tricky combination and very hard to pull off in Excel. The reason for this has several aspects. If you close the Workbook using the top right X this will trigger the Workbook_BeforeClose the document is expected to be closed in that event. If for some reason the user cancels the closing this will give you another unexpected state where when pressing the X again the Workbook_BeforeClose does not seem to be triggered again, but now the Workbook_BeforeSave (the built in version) is triggered.

Here is a start to get you on your way to also implement the xltm save, but as said it will be limiting as you force the user to either save the workbook and exit or don't save but still exiting the workbook. It is a bit dirty (goto label etc) but you get my drift.

There are many Close/Save combinations in Excel and it is hard to catch all the right combinations, so you might want to decide to handle it completely different ...

Private Sub Workbook_BeforeClose(Cancel As Boolean)

  If ActiveWorkbook.Saved = True Then
     Cancel = False
  Else

     Dim iReply As Byte, iType As Integer

     Dim events As Boolean
     Dim alerts As Boolean

     events = Application.EnableEvents
     alerts = Application.DisplayAlerts

     Application.EnableEvents = False
     Application.DisplayAlerts = False

  StartQuestion:

     ' Define buttons argument.
     iType = vbYesNo + vbQuestion + vbDefaultButton2
     iReply = MsgBox("Would you like to save now?", iType)

     Select Case iReply
       Case Is = vbYes         ' user chose Yes save current workbook

         'The following statements shows the save as dialog box with default path
         Set FileSaveName = Application.FileDialog(msoFileDialogSaveAs)

         FileSaveName.InitialFileName = ThisWorkbook.Name
         FileSaveName.FilterIndex = 2   'select to save with a ".xlsm" extension
         FileSaveName.Title = "Save As ... "

         intchoice = FileSaveName.Show

         If intchoice = 0 Then
         Else
            FileSaveName.Execute
         End If

         If ActiveWorkbook.Saved = True Then
            ActiveWorkbook.Close
            Cancel = False
         Else
            GoTo StartQuestion
         End If

      Case Is = vbNo           ' user chose No, don't save

        ActiveWorkbook.Saved = True
        ActiveWorkbook.Close
        Cancel = False

     End Select

     Application.EnableEvents = events
     Application.DisplayAlerts = alerts

   End If

End Sub

Answer 3

Thanks all for your help. I figured out the solution.

Private Sub Workbook_BeforeClose(Cancel As Boolean)

StartQuestion:
Cancel = True
'Evaluate if workbook is saved and emulate default propmts
With ThisWorkbook
     Select Case MsgBox("Do you want to save the changes you made to '" & .Name & "'?", _
         vbYesNoCancel + vbExclamation)
         Case Is = vbYes
             Call CustomSave(vbYes)
             If cancelclicked = False Then
                ThisWorkbook.Saved = True
             Else
                GoTo StartQuestion
             End If
         Case Is = vbNo
             ThisWorkbook.Saved = True
         Case Is = vbCancel
             Exit Sub
     End Select
End With
Cancel = False
End Sub

Sub CustomSave(ans As Long)
Dim MinExtensionX
Dim Arr() As Variant
Dim lngLoc As Variant
Dim events As Boolean
Dim alerts As Boolean
If ActiveWorkbook.Saved = True Then
     Cancel = False
Else
     events = Application.EnableEvents
     alerts = Application.DisplayAlerts

     Application.EnableEvents = False
     Application.DisplayAlerts = False

StartQuestion:
    Select Case ans
    Case Is = vbYes         ' user chose Yes save current workbook
        MinExtensionX = Mid(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".") + 1)
        Arr = Array("xlsx", "xlsm", "xlsb", "xls", "xml", "mht", "mhtml", "htm", "html", "xltx", "xltm", "xlt", "txt", "csv", "prn", "dif", "slk", "xlam", "xla", "pdf", "xps", "ods") 'define which extensions you want to allow
        On Error Resume Next
        lngLoc = Application.WorksheetFunction.Match(MinExtensionX, Arr(), 0)
        If IsEmpty(lngLoc) Then '
            'The following statements shows the save as dialog box with default path
             Set FileSaveName = Application.FileDialog(msoFileDialogSaveAs)

             FileSaveName.InitialFileName = ThisWorkbook.Name
             FileSaveName.FilterIndex = 2   'select to save with a ".xlsm" extension
             FileSaveName.Title = "Save As ... "

             intchoice = FileSaveName.Show
             If intchoice = 0 Then
                cancelclicked = True
             Else
                FileSaveName.Execute
             End If
        Else
            ThisWorkbook.Save
        End If
 End Select
 End If
 End Sub