Workbook BeforeClose Cancel button

Jaafar Tribak

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
9,806
Office Version
  1. 2016
Platform
  1. Windows
Hi dear members,

Let's assume there is a workbook project where an API timer (SetTimer) is started in the workbook open event... This timer is supposed to be running thoughout the life of the workbook until it is closed.

In the workbook before_close event, the timer is cancelled by calling the (KillTimer) API. This step in imperative because Excel crashes if the workbook is closed without properly cancelling the API timer.

Now the problem is that if the workbook is unsaved at the time of closing , Excel displays the usual prompt (Save,Don't Save,Cancel) and if the user happens to click on the cancel button, the workbook will remain open but now the timer is already cancelled which I don't want because, as I said, I need the timer to stay running until the workbook is actually really closed.

So maybe what I need is a way of knowing if the user has clicked the Cancel button and if so, restart the timer again.

I was thinking of replacing the beforeclose prompt with a userform containing similar buttons and execute code respectively according to which button was clicked but I find this approach rather messy.

I was wondering if there is a more self-contained way code-wise other than having to use a separate userform... Any ideas ?

Regards.
 

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.
Sort by date Sort by votes
You can check the Saved property of the workbook, then pop up the Application.GetSaveAsFilename dialog so that you can handle the save/cancel as necessary.
 
Upvote 0
RoryA said:
You can check the Saved property of the workbook, then pop up the Application.GetSaveAsFilename dialog so that you can handle the save/cancel as necessary.
Click to expand...

Thanks Rory,

I had been thinking about different workarounds but the idea of Displaying the GetSaveAsFilename didn't occur to me .. Sounds feasible but it can be rather confusing and unfamiliar for the not so experienced user.

I was just starting to write some API-based code to see if I could detect which button of the prompt was clicked but to my surprise, I have just discovered using a Spy tool that the beforeclose buttons are windowless controls ! This makes it all the more difficult ulness I manage to access the buttons through MSAAccessibility .

If anything comes up I'll post it here later.
 
Last edited:
Upvote 0
Why would it be unfamiliar to the user? It's the same Save dialog they are used to.
 
Upvote 0
RoryA said:
Why would it be unfamiliar to the user? It's the same Save dialog they are used to.
Click to expand...

I meant that we are used to seeing the save dialog upon close only when the workbook is being saved for the first time
 
Upvote 0
Oh I see. If the workbook has already been saved once (Path is not "") then you can just use a Msgbox can't you?
 
Upvote 0
RoryA said:
Oh I see. If the workbook has already been saved once (Path is not "") then you can just use a Msgbox can't you?
Click to expand...

Yes. A Msgbox would do specially if using vbYesNoCancel buttons along with a text prompt as that of the excel beforeclose message.

Taking this a step further, one could even change the Msgbox buttons captions from (Yes,No and Cancel) to (Save, Don't Save and Cancel) because the Msgbox buttons are real windows with a hwnd and a Dialog control ID each.

I'll give this a try and see what I get.

Thanks for the suggestion.
 
Last edited:
Upvote 0
Hi Rory,

Back with this using MSAAccessibility to detect if the user clicked the Cancel button and if so, run code afterwards .. tested on excel 2010/ Win 64 and seems stable and working fine.

1- In a Standard Module:
Code: 
Option Explicit

Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type

[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  VBA7 Then
    Declare PtrSafe Function AccessibleObjectFromWindow Lib "oleacc" (ByVal hwnd As LongPtr, ByVal dwId As Long, ByRef riid As GUID, ByRef ppvObject As Any) As Long
    Declare PtrSafe Function AccessibleChildren Lib "oleacc" (ByVal paccContainer As Office.IAccessible, ByVal iChildStart As Long, ByVal cChildren As Long, ByRef rgvarChildren As Any, ByRef pcObtained As Long) As Long
    Declare PtrSafe Function IIDFromString Lib "ole32.dll" (ByVal lpsz As LongPtr, lpiid As GUID) As Long
    Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As Long) As LongPtr
    Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hhk As LongPtr) As Long
    Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal ncode As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
    Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
    Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
    Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
    
    Dim hHook As LongPtr
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
    Declare Function AccessibleObjectFromWindow Lib "oleacc" (ByVal hwnd As Long, ByVal dwId As Long, ByRef riid As GUID, ByRef ppvObject As Any) As Long
    Declare Function AccessibleChildren Lib "oleacc" (ByVal paccContainer As Office.IAccessible, ByVal iChildStart As Long, ByVal cChildren As Long, ByRef rgvarChildren As Any, ByRef pcObtained As Long) As Long
    Declare Function IIDFromString Lib "ole32.dll" (ByVal lpsz As Long, lpiid As GUID) As Long
    Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
    Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hhk As Long) As Long
    Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
    Declare Function GetCurrentThreadId Lib "kernel32" () As Long
    Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
    Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
    
    Dim hHook As Long
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If

Const WH_CBT = 5
Const HCBT_DESTROYWND = 4
Const CHILDID_SELF = &H0&
Const NAVDIR_FIRSTCHILD = &H7&
Const S_OK = &H0&
Const OBJID_CLIENT = &HFFFFFFFC
Const IID_IAccessible = "{618736E0-3C3D-11CF-810C-00AA00389B71}"

Public Property Let MonitorClosePrompt(ByVal Monitor As Boolean)
    If ThisWorkbook.Saved Then Exit Property
    If Monitor Then
        If hHook <> 0 Then Exit Property
        hHook = SetWindowsHookEx(WH_CBT, AddressOf CBT_Func, 0, GetCurrentThreadId())
    Else
        If hHook = 0 Then Exit Property
        Call UnhookWindowsHookEx(hHook)
        hHook = 0
    End If
End Property

Function CBT_Func(ByVal ncode As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
    Dim IID As GUID
    Dim oAccObj As Variant
    Dim sBuffer As String * 255
    
    On Error Resume Next
    If ncode = HCBT_DESTROYWND Then
        If GetClassName(wParam, sBuffer, Len(sBuffer)) <> 0& Then
            If Left$(sBuffer, InStr(sBuffer, vbNullChar) - 1&) = "NUIDialog" Then
                MonitorClosePrompt = False
                Call IIDFromString(StrPtr(IID_IAccessible), IID)
                If AccessibleObjectFromWindow(wParam, OBJID_CLIENT, IID, oAccObj) = S_OK Then
                    If AccessibleChildren(oAccObj, 0, 1, oAccObj, 1) = S_OK Then
                        Set oAccObj = oAccObj.accNavigate(NAVDIR_FIRSTCHILD, CHILDID_SELF)
                        Set oAccObj = oAccObj.accNavigate(NAVDIR_FIRSTCHILD, CHILDID_SELF)
                        AccessibleChildren oAccObj, 10, 1, oAccObj, 1
                        If IsEmpty(oAccObj.accFocus) Then
                            Debug.Print "CANCEL button clicked !"
                            SetTimer Application.hwnd, 0, 0, AddressOf AfterCancelMacro
                        End If
                End If
            End If
        End If
        End If
    End If
    CBT_Func = CallNextHookEx(hHook, ncode, wParam, lParam)
End Function

Sub AfterCancelMacro()

    On Error Resume Next
        KillTimer Application.hwnd, 0
    On Error GoTo 0
    
    MsgBox "CANCEL button clicked !" & vbLf & vbLf & _
    "Running vba code after cancelling the closing of the workbook is now possible."
    
[B][COLOR=#008000]    'Other code goes here ....[/COLOR][/B]
End Sub

2- Code usage in the ThisWorkbook Module :
Code: 
Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)

    MonitorClosePrompt = True
    
[B][COLOR=#008000]    'Other existing closing code goes here...[/COLOR][/B]

End Sub

I'll see if I can write an alternative code that uses the Msgbox approach and customizes it for the sake of completeness.
 
Last edited:
Upvote 0
There was an error with the above code in post#8 in accessing the correct Prompt button plus I have just realised one other thing : The above code doesn't cater either for the scenario where the beforeclose Cancel argument is set to TRUE... I had missed out this very important bit as well .

The following code update makes up for that by passing the BeforeClose Cancel argument to the MonitorClosePrompt Property in its first parameter.

1- Code in a Standard Module :
Code: 
Option Explicit

Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type

[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  VBA7 Then
    Declare PtrSafe Function AccessibleObjectFromWindow Lib "oleacc" (ByVal hwnd As LongPtr, ByVal dwId As Long, ByRef riid As GUID, ByRef ppvObject As Any) As Long
    Declare PtrSafe Function AccessibleChildren Lib "oleacc" (ByVal paccContainer As Office.IAccessible, ByVal iChildStart As Long, ByVal cChildren As Long, ByRef rgvarChildren As Any, ByRef pcObtained As Long) As Long
    Declare PtrSafe Function IIDFromString Lib "ole32.dll" (ByVal lpsz As LongPtr, lpiid As GUID) As Long
    Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As Long) As LongPtr
    Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hhk As LongPtr) As Long
    Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal ncode As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
    Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
    Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
    Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
    
    Dim hHook As LongPtr
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
    Declare Function AccessibleObjectFromWindow Lib "oleacc" (ByVal hwnd As Long, ByVal dwId As Long, ByRef riid As GUID, ByRef ppvObject As Any) As Long
    Declare Function AccessibleChildren Lib "oleacc" (ByVal paccContainer As Office.IAccessible, ByVal iChildStart As Long, ByVal cChildren As Long, ByRef rgvarChildren As Any, ByRef pcObtained As Long) As Long
    Declare Function IIDFromString Lib "ole32.dll" (ByVal lpsz As Long, lpiid As GUID) As Long
    Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
    Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hhk As Long) As Long
    Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
    Declare Function GetCurrentThreadId Lib "kernel32" () As Long
    Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
    Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
    
    Dim hHook As Long
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If

Const WH_CBT = 5
Const HCBT_DESTROYWND = 4
Const CHILDID_SELF = &H0&
Const NAVDIR_FIRSTCHILD = &H7&
Const NAVDIR_NEXT = &H5&
Const S_OK = &H0&
Const OBJID_CLIENT = &HFFFFFFFC
Const IID_IAccessible = "{618736E0-3C3D-11CF-810C-00AA00389B71}"


Public Property Let MonitorClosePrompt(ByVal BeforeCloseCancelArgument As Boolean, ByVal Monitor As Boolean)
    If ThisWorkbook.Saved Then Exit Property
    If BeforeCloseCancelArgument And Monitor Then Exit Property    
    If Monitor Then
        If hHook <> 0 Then Exit Property        
        hHook = SetWindowsHookEx(WH_CBT, AddressOf CBT_Func, 0, GetCurrentThreadId())
    Else
        If hHook = 0 Then Exit Property        
        Call UnhookWindowsHookEx(hHook)
        hHook = 0
    End If
End Property

Function CBT_Func(ByVal ncode As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
    Dim IID As GUID
    Dim oAccObj As IAccessible
    Dim vCancelBtn As Variant
    Dim sBuffer As String * 255
    Dim i As Long
    
    On Error Resume Next
    If ncode = HCBT_DESTROYWND Then
        If GetClassName(wParam, sBuffer, Len(sBuffer)) <> 0 Then
            If Left$(sBuffer, InStr(sBuffer, vbNullChar) - 1) = "NUIDialog" Then
                MonitorClosePrompt(BeforeCloseCancelArgument:=False) = False
                Call IIDFromString(StrPtr(IID_IAccessible), IID)
                If AccessibleObjectFromWindow(wParam, OBJID_CLIENT, IID, oAccObj) = S_OK Then
                    If AccessibleChildren(oAccObj, 0, 1, vCancelBtn, 1) = S_OK Then
                        Set vCancelBtn = vCancelBtn.accNavigate(NAVDIR_FIRSTCHILD, CHILDID_SELF)
                        Set vCancelBtn = vCancelBtn.accNavigate(NAVDIR_FIRSTCHILD, CHILDID_SELF)
                        For i = 1 To 10
                            Set vCancelBtn = vCancelBtn.accNavigate(NAVDIR_NEXT, CHILDID_SELF)
                            If i = 10 And Not IsEmpty(vCancelBtn.accFocus) Then
                                Debug.Print "You Clicked CANCEL"
                                SetTimer Application.hwnd, 0, 0, AddressOf AfterCancelMacro
                                GoTo NxtHook
                            End If
                        Next i
                    End If
                End If
            End If
        End If
    End If
NxtHook:
    CBT_Func = CallNextHookEx(hHook, ncode, wParam, lParam)
End Function

Sub AfterCancelMacro()

    On Error Resume Next
        KillTimer Application.hwnd, 0
    On Error GoTo 0
    
    MsgBox "CANCEL button clicked !" & vbLf & vbLf & _
    "Running vba code after cancelling the closing of the workbook is now possible."
    
[COLOR=#008000]    'Other code goes here ....[/COLOR]
End Sub

2- Code in the ThisWorkbook Module :
Code: 
Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    
[COLOR=#008000]    'Other existing closing code goes here...
[/COLOR]
   [B][COLOR=#008000]   '=========================================================================[/COLOR][/B]
[B][COLOR=#008000]        'IMPORTANT !! This line must be the last line in the BeforeClose event.[/COLOR][/B]
[B][COLOR=#008000]        '=========[/COLOR][/B]
        MonitorClosePrompt(BeforeCloseCancelArgument:=Cancel) = True
[B][COLOR=#008000]    '=========================================================================[/COLOR][/B]
End Sub
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Solved
CLose a Userfom After 10 Seconds or When User Clicks Button
Replies
3
Views
121
Jaafar Tribak
Jaafar Tribak
V
  • Solved
Workbook with Timer Macro Saving After Closing
Replies
1
Views
818
John_w
J
T
  • Question Question
UserForm Close Event Hangs
Replies
0
Views
532
trough
T
L
  • Solved
How to close workbook in the background
Replies
9
Views
810
Alex Blakenburg
A
T
  • Question Question
Custom ribbon Delete button status at runtime
Replies
6
Views
298
tiredofit
T

Forum statistics

Threads
1,224,823
Messages
6,181,177
Members
453,021
Latest member
Justyna P

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top