Before_Close Event Cleanup Limitation

[Jaafar Tribak]

You are familiar with this screen (except for the funny french letters ) It pops up on your screens each time you try to close an unsaved workbook which is great as it reminds you before you lose data.

So where is the problem ? The problem is that this screen pops up AFTER any potential cleanup code is executed in the BeforeClose event.

Let me explain why this can be problematic : Now what happens if the user clicks the Cancel button and decides to carry on working with the workbook ? The answer is that there will be many scenarios where the workbook will stop working properly .

One scenario is a running OnTime procedure that is being cancelled in the BeforeClose event. After the user clicks the Prompt Cancel button, the OnTime will no longer work !

I can think of many other scenarios where aborting the workbook closing process could cause problems later on if there is some cleanup code in the before_close event.

So here is the question: Is it possible to run code AFTER the save Prompt in order to overcome the problem explained above ? In other words : If the user clicks the Yes or No buttons then run the cleanup code but if the Cancel button is the one that's been clicked do nothing.

 

[Jaafar Tribak]

Sorry to be a pain but after some further testing I setteled on this final amended version : ( Pls, ignore the code in the previous post)


1- In the Workbook module :

Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)

   [B][COLOR=Green] 'CleanUp code goes here before the Monitor_Save_Changes[/COLOR][/B]
    Monitor_Save_Changes = True

End Sub


'This Procedure MUST be Public
Public Sub MonitorProc(UserAction As Yes_No_Cancel)

    Select Case UserAction
        Case Is = Yes
            MsgBox "You Saved changes."
        Case Is = No
            MsgBox "You Discarded changes."
        Case Is = Cancel
            MsgBox "You Canceled Closing"
           [B][COLOR=Green] 'undo any before_close cleanup code here...[/COLOR][/B]
    End Select

End Sub

2- In a Standard module :

Option Explicit

Enum Yes_No_Cancel
    Yes = 6
    No = 7
    Cancel = 2
End Enum

Private Declare Function FindWindow Lib "user32.dll" _
Alias "FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
 
Private Declare Function GetWindowLong Lib "user32" _
Alias "GetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal nIndex As Long) As Long

Private Declare Function SetWindowLong Lib "user32" _
Alias "SetWindowLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal lNewLong As Long) As Long

Private Declare Function CallWindowProc Lib "user32" _
Alias "CallWindowProcA" _
(ByVal lpPrevWndFunc As Long, _
ByVal hwnd As Long _
, ByVal Msg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
 
Private 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
 
Private Declare Function CallNextHookEx Lib "user32" _
(ByVal hHook As Long, _
ByVal nCode As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
 
Private Declare Function UnhookWindowsHookEx Lib "user32" _
(ByVal hHook As Long) As Long
 
Private Declare Function GetCurrentThreadId Lib "kernel32" _
() As Long
 
Private Declare Function GetClassName Lib "user32.dll" _
Alias "GetClassNameA" _
(ByVal hwnd As Long, _
ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long

Private Declare Function SetTimer Lib "user32" _
(ByVal hwnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long
 
Private Declare Function KillTimer Lib "user32" ( _
ByVal hwnd As Long, _
ByVal uIDEvent As Long) As Long


Private Const WH_CBT = 5
Private Const GWL_HINSTANCE = (-6)
Private Const HCBT_CREATEWND = 3
Private Const GWL_WNDPROC = (-4)
Private Const WM_COMMAND = &H111
Private Const BN_CLICKED = 0

Private lCBTHook  As Long
Private lPrevWnProc As Long
Public glLoword As Long
Private glHwnd As Long
Private glMsg As Long
Private glWparam As Long
Private glLparam As Long


'*******************
'Public Property.
'*******************
Public Property Let Monitor_Save_Changes(ByVal Status As Boolean)

    'Set a CBT hook to catch the 'Save Changes' Wnd creation.
    If Not ThisWorkbook.Saved And Status Then
        lCBTHook = SetWindowsHookEx(WH_CBT, AddressOf CBTProc, _
                   GetAppInstance, GetCurrentThreadId)
    End If

End Property



'*******************
'Private Routines.
'*******************

Private Function CBTProc _
(ByVal idHook As Long, ByVal wParam As Long, _
 ByVal lParam As Long) As Long
 
    Dim sBuffer As String
    Dim lRetVal As Long
 
    Select Case idHook
        Case Is = HCBT_CREATEWND
            'Some Wnd has been created within the excel process.
            sBuffer = Space(256)
            lRetVal = GetClassName(wParam, sBuffer, 256)
            'Is it our 'SaveChanges' wnd ?
            If Left(sBuffer, lRetVal) = "#32770" Then
            'if so subclass it now.
            lPrevWnProc = SetWindowLong _
            (wParam, GWL_WNDPROC, AddressOf CallBack)
            End If
            'done with hook.
            UnhookWindowsHookEx lCBTHook
    End Select
    
    'Call next hook if any.
    CBTProc = CallNextHookEx _
    (lCBTHook, idHook, ByVal wParam, ByVal lParam)
 
End Function


Private Function CallBack _
(ByVal hwnd As Long, ByVal Msg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
 
    On Error Resume Next
    
    Dim LowWord As Long, HighWord As Long
    
    'Process the notifications sent by the buttons in the 'Save changes' Wnd.
    Select Case Msg
        Case WM_COMMAND
            GetHiLoword wParam, LowWord, HighWord
            Call SetWindowLong(hwnd, GWL_WNDPROC, lPrevWnProc)
            'store the arg values for later use in the TimerProc
            glHwnd = hwnd
            glMsg = Msg
            glWparam = wParam
            glLparam = lParam
            glLoword = LowWord
            'run the timer
            SetTimer Application.hwnd, 0, 1, AddressOf TimerProc
            If LowWord = Yes_No_Cancel.Yes Or LowWord = Yes_No_Cancel.No Then
                Exit Function
            End If
    End Select
    
    CallBack = CallWindowProc _
    (lPrevWnProc, hwnd, Msg, wParam, ByVal lParam)

End Function


Private Sub TimerProc()

    On Error Resume Next
    
    KillTimer Application.hwnd, 0
    Call ThisWorkbook.MonitorProc(glLoword)
    Call CallWindowProc _
    (lPrevWnProc, glHwnd, glMsg, glWparam, ByVal glLparam)

End Sub


Private Sub GetHiLoword _
(wParam As Long, ByRef loword As Long, ByRef hiword As Long)
 
   ' this is the LOWORD of the wParam:
    loword = wParam And &HFFFF&
    ' LOWORD now equals 65,535 or &HFFFF
    ' this is the HIWORD of the wParam:
    hiword = wParam \ &H10000 And &HFFFF&
    ' HIWORD now equals 30,583 or &H7777
 
End Sub

Private Function GetAppInstance() As Long
 
    GetAppInstance = GetWindowLong _
    (FindWindow("XLMAIN", Application.Caption), GWL_HINSTANCE)
 
End Function