How to detect when a workbook is closing?

Question

The Workbook.BeforeClose event triggers when the workbook is about to close but before the saving message prompt which allows cancelling it.

How can I detect when the workbook is already closing past the point where it can be cancelled without removing nor replacing the saving message with a custom one?

One workaround I have found online is to use the event together with the Workbook.Deactivate event which looks like this:

Code in the workbook:

Private Sub Workbook_BeforeClose(ByRef Cancel As Boolean)

  closing_event = True
  check_time = VBA.Now + VBA.TimeSerial(Hour:=0, Minute:=0, Second:=1)
  Excel.Application.OnTime EarliestTime:=check_time, Procedure:="disable_closing_event"

End Sub

Private Sub Workbook_Deactivate()

  If closing_event Then
    VBA.MsgBox Prompt:="Closing event."
    Excel.Application.OnTime EarliestTime:=check_time, Procedure:="disable_closing_event", Schedule:=False
  End If

End Sub

Code in a module:

Public closing_event As Boolean
Public check_time As Date

Public Sub disable_closing_event()

  closing_event = False

End Sub

One very specific edge case where it triggers incorrectly is if you click to close the workbook and in less than one second close the saving message (press Esc to do it fast enough) and change to another workbook (Alt + Tab) it triggers the Deactivate event with the closing_event condition variable still set to True because disable_closing_event has still not set it to False (scheduled by Application.OnTime for when one second goes by).

I would like to find a solution that isn't so much of a workaround and that works correctly against that edge case.

Edit:

The accepted answer has the best solution in my opinion out of all the current answers. I have modified it for my needs and preference to the following code in the workbook:

Private WorkbookClosing As Boolean

Private Sub Workbook_BeforeClose(Cancel As Boolean)
  WorkbookClosing = True
End Sub

Private Sub Workbook_Deactivate()
  If WorkbookClosing And ThisWorkbook.Name = ActiveWindow.Caption Then
    Workbook_Closing
  Else
    WorkbookClosing = False
  End If
End Sub

Private Sub Workbook_Closing()
  MsgBox "Workbook_Closing event."
End Sub

Answer 1

This is an evolution of my 1st Answer - it detects the edge case problem by comparing the ActiveWindow.Caption against ThisWorkbook.Name so it can detect that issue and deal with it. It's not the most elegant solution but I believe it works.

All Code in the Workbook most of it in DeActivate

Public ByeBye As String

Private Sub Workbook_BeforeClose(Cancel As Boolean)
   ByeBye = "B4C"
End Sub

Private Sub Workbook_Deactivate()
   If ByeBye = "B4C" Then
      If ActiveWindow.Caption = ThisWorkbook.Name Then
         If ThisWorkbook.Saved Then
            MsgBox "No problem - Closing after Saving"
         Else
            MsgBox "No problem - Closing without Saving"
         End If
      Else
         If ThisWorkbook.Saved Then
            MsgBox "No problem - New Workbook Activation"
         Else
            MsgBox "Oops Try Again You Cannot Activate '" & ActiveWindow.Caption & "' until '" & ThisWorkbook.Name & "' has completed processing & IT HAS NOW COMPLETED", vbOKOnly, "Hiding"
            ThisWorkbook.Activate
         End If
      End If
   Else
      MsgBox "No problem - Just Hiding"
   End If
   ByeBye = "Done"
End Sub

Private Sub Workbook_Open()
   ByeBye = "OPENED"
End Sub

In response to comment about saving I tested this for 7 possible combinations as follows

 1) Closing without Edits - No Saving Involved ... MsgBox Prompted with ... No problem - Closing after Saving       
 2) Not closing - Just Switch Workbook - Whether Edited or Not ... MsgBox Prompted with ... No problem - Just Hiding        
 3) Not closing - Switch Workbook - After Edit & Cancel ... MsgBox Prompted with ... Oops Try Again …       
 4) Closing and saving ... MsgBox Prompted with ... No problem - Closing after Saving       
 5) Closing and Saving after a prior Cancel ... MsgBox Prompted with ... No problem - Closing after Saving      
 6) Closing but Not Saving ... MsgBox Prompted with ... No problem - Closing without Saving         
 7) Closing but not Saving after a prior Cancel ... MsgBox Prompted with ... No problem - Closing without Saving        

Answer 2

I think trying to cancel the close event is the wrong approach for what you are trying to do. A better approach would be to have a function that is only called when the workbook is actually closing.

Thank you for the comments regarding OnTime not being called while the dialog is open as that pointed me in the right direction. What we need to test is the time between the workbook deactivation and the closing of either the workbook itself or the save dialog. Using the Excel.Application.OnTime function to set this close time means this is possible as it can be delayed until the save dialogue has closed.

Once we have this time, a simple comparison to the deactivation time allows us to decide whether to call the exit function or not.

I initially ran into issues with the workbook reopening to run the .OnTime procedure, so an artificial delay needs to be added into the Deactivation function so the workbook hasn't closed until the close time has been set. Using the code from here - Delay Macro to allow events to finish we can accomplish this.

In ThisWorkbook

Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Excel.Application.OnTime EarliestTime:=Now, Procedure:="SetCloseTime"
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    If Timer < CloseTime + 0.2 Then Call CloseProcedure
End Sub

Private Sub Workbook_Deactivate()
    Delay (0.3)
    If Timer < CloseTime + 0.4 Then Call CloseProcedure
End Sub

In a module

Option Explicit

Public CloseTime As Single

Function SetCloseTime()
    CloseTime = Timer
End Function

Function Delay(Seconds As Single)
    Dim StopTime As Single: StopTime = Timer + Seconds
    Do While Timer < StopTime
        DoEvents
    Loop
End Function

Function CloseProcedure()
    MsgBox "Excel is closing"
End Function

The .OnTime seems to run within one second cycles which dictates the length of the delay and the time difference test has a little leeway added with an additional 1/10th of a second (which I found necessary). These timings could potentially need slight tweaking but have so far worked for me with the different scenarios when closing the workbook.

Answer 3

In order to get around your edge case, you need to handle the case where the workbook is deactivated within 1 second of closing it, but only when the save prompt was displayed.

To check if less than 1 second has elapsed, use a high resolution timer to store the time in the Workbook_BeforeClose event, and then compare against it in the Workbook_Deactivate event. Assuming that clsTimer is a suitable high res timer, your code should now be:

Private MyTimer As clsTimer
Private StartTime As Currency

Private Sub Workbook_BeforeClose(ByRef Cancel As Boolean)

    closing_event = True
    Set MyTimer = New clsTimer
    StartTime = MyTimer.MicroTimer
    check_time = VBA.Now + VBA.TimeSerial(Hour:=0, Minute:=0, Second:=1)
    Excel.Application.OnTime EarliestTime:=check_time, Procedure:="disable_closing_event"

End Sub

Private Sub Workbook_Deactivate()

    If closing_event Then

        If Not ThisWorkbook.Saved Then
            'The Save prompt must have been displayed, and the user clicked No or Cancel or pressed Escape

            If MyTimer.MicroTimer - StartTime < 1 Then
                'The user must have pressed Escape and Alt-Tabbed
                closing_event = False
            Else
                'Your Windows API calls here
            End If
        Else
            'The workbook was saved before the close event, so the Save prompt was not displayed
            'Your Windows API calls here
        End If
        Excel.Application.OnTime EarliestTime:=check_time, Procedure:="disable_closing_event", Schedule:=False
    End If

    Set MyTimer = Nothing

End Sub

The class module for clsTimer looks like this:

Private Declare PtrSafe Function getFrequency Lib "kernel32" _
Alias "QueryPerformanceFrequency" (cyFrequency As Currency) As Long

Private Declare PtrSafe Function getTickCount Lib "kernel32" _
Alias "QueryPerformanceCounter" (cyTickCount As Currency) As Long


Public Function MicroTimer() As Currency

    ' Returns seconds.

    Dim cyTicks1 As Currency
    Static cyFrequency As Currency

    MicroTimer = 0

    ' Get frequency.
    If cyFrequency = 0 Then getFrequency cyFrequency

    ' Get ticks.
    getTickCount cyTicks1

    ' Seconds
    If cyFrequency Then MicroTimer = cyTicks1 / cyFrequency

End Function