Before_Close Event Cleanup - Update

[DarkLife]

So I just convert my vba code to addoin (.xlam) for better way to update code for multiple workbooks.

I create function that runs every time when window is change (Application.OnWindow = function).
Each time this function runs it does multiple checks and set the workbook to public class modul -> Public WithEvents ... As Workbook.

This was working fine, but I run in to a problem, when user closes different workbook from windows bottom ribbon the excel doesnt run before_close event for that workbook.
So I create a collection, where I store workbooks - each time window is change function (Application.OnWindow = function) checks if workbook is in collection if not add the workbook WithEvent.

This again was working fine even when user closed the workbook from ribbon, but again I run into another problem. When user closed the workbook (and there was another workbook open) it would not remove the event from collection. So again I create delete mesure on workbook before_close.

And there is my final problem with before close prompt. This prompt runs after Before_Close event and I cant tell if I shoudl delete the event from collection or not.

I find temporerly fix from old post Before_Close Event Cleanup Limitation which works fine, but I woudl prefer to keep original prompt...
So I tried other option on same post from Jaafar Tribak Before_Close Event Cleanup Limitation It didnt work beacues of my version so I rewrite Declare functions for different versions, but it still doesnt work :

Workbook module:

Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)

    'CleanUp code goes here before the Monitor_Save_Changes
    Monitor_Save_Changes = True

End Sub
'This Procedure MUST be Public
Public Sub MonitorProc(UserAction As Yes_No_Cancel)
    Debug.Print "RUN"
    Select Case UserAction
        Case Is = Yes
            MsgBox "You Saved changes."
        Case Is = No
            MsgBox "You Discarded changes."
        Case Is = Cancel
            MsgBox "You Canceled Closing"
            'undo any before_close cleanup code here...
    End Select

End Sub

Standard module:

Option Explicit

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

#If VBA7 Then
    #If Win64 Then
        Private Declare PtrSafe Function WindowFromAccessibleObject Lib "oleacc" (ByVal pacc As IAccessible, phwnd As LongPtr) As Long
        Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongPtrA" (ByVal hWnd As LongLong, ByVal nIndex As Long) As LongLong
        Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongPtrA" (ByVal hWnd As LongLong, ByVal nIndex As Long, ByVal dwNewLong As LongLong) As LongLong
    #Else
        Private Declare PtrSafe Function WindowFromAccessibleObject Lib "oleacc" (ByVal pacc As Object, phwnd As LongPtr) As Long
        Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
        Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    #End If
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Private 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
    Private Declare PtrSafe Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As LongPtr, ByVal hWnd As LongPtr, ByVal MSG As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
    Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal nCode As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
    Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hhk As LongPtr) As Long
    Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
    Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
    Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal uIDEvent As Long) As Long
#Else

    Private Declare Function WindowFromAccessibleObject Lib "oleacc" (ByVal pacc As IAccessible, phwnd As Long) As Long
    Private Declare Function FindWindow Lib "user32" 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 dwNewLong 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 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 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 hhk As Long) As Long
    Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
    Private Declare Function GetClassName Lib "user32" 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
#End If

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 ActiveWorkbook.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 'Or Left(sBuffer, lRetVal) = "NUIDialog" 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
    
    Debug.Print "CallBack"
    
    'Process the notifications sent by the buttons in the 'Save changes' Wnd.
    Select Case MSG
        Case WM_COMMAND
            Debug.Print "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
    
    Debug.Print "TimerProc"
    
    KillTimer Application.hWnd, 0
    Call ActiveWorkbook.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

So I am asking. How to make that code work or should I change my whole set with events approach and try somethink different ?