excel - Why can't I `End` code while I'm subclassing without breaking everything?

Question

Context

I've written some code in VBA to subclass a userform so that ultimately I can intercept WM_TIMER messages being dispatched to it. I'm doing this instead of specifying a TIMERPROC, as it allows me to use VBA's own error handling and calling methods to run callback functions. I'm using a userform rather than Application.hWnd because:

1. I don't have to filter for my vs Excel/the host application's messages.
2. There are far too many messages going through Application.hWnd to be able to subclass it in a slow interpreted language like VBA.
3. When code execution is interrupted (pressing the stop button, or upon encountering an End statement), the userform vanishes all by itself - disconnecting any timers still sending messages.
   • Using the Application window, or worse, creating my own message window as I had previously been doing means the timers created with SetTimer continue to trigger my message window

It's all working fine, except I've found that occasionally when my code is up and running, and I press the reset/stop button, everything crashes.

I'd prefer for my window to be un-subclassed and destroyed safely.

---

I created the following to allow me to subclass a userform (no timers yet, the problem manifests itself just by subclassing):

Standard module: WinAPI

I'm using the new style of subclassing because MSDN told me to, and in case I need to add more subclasses - shouldn't make a difference though.

Option Explicit

Public Enum WindowsMessage 'As Long - for intellisense
    WM_TIMER = &H113 'only care about this one
    '...
End Enum

Public Declare Function DefSubclassProc Lib "comctl32.dll" Alias "#413" ( _
                        ByVal hWnd As LongPtr, _
                        ByVal uMsg As WindowsMessage, _
                        ByVal wParam As LongPtr, _
                        ByVal lParam As LongPtr) As LongPtr

Public Declare Function SetWindowSubclass Lib "comctl32.dll" Alias "#410" ( _
                        ByVal hWnd As LongPtr, _
                        ByVal pfnSubclass As LongPtr, _
                        ByVal uIdSubclass As LongPtr, _
                        Optional ByVal dwRefData As LongPtr) As Long

Public Declare Function RemoveWindowSubclass Lib "comctl32.dll" Alias "#412" ( _
                        ByVal hWnd As LongPtr, _
                        ByVal pfnSubclass As LongPtr, _
                        ByVal uIdSubclass As LongPtr) As Long

For more WinAPI functions to help with debugging, like SetTimer and Peek/PostMessage use this full version of the module

Userform: ModelessMessageWindow

I've got showModal set to False, but I never .Show so probably irrelevant

'@Folder("FirstLevelAPI")
Option Explicit

Private Type messageWindowData
    subClassIDs As New Dictionary '{proc:id}
End Type
Private this As messageWindowData

#If VBA7 Then
    Private Declare PtrSafe Function IUnknown_GetWindow Lib "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByRef outHwnd As LongPtr) As Long
#Else
    Private Declare Function IUnknown_GetWindow Lib "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByRef outHwnd As Long) As Long
#End If

#If VBA7 Then
    Public Property Get handle() As LongPtr
        IUnknown_GetWindow Me, handle
    End Property
#Else
    Public Property Get handle() As Long
        IUnknown_GetWindow Me, handle
    End Property
#End If

Public Function tryCreate(ByRef outWindow As ModelessMessageWindow, Optional ByVal windowProc As LongPtr = 0, Optional ByVal data As LongPtr) As Boolean
    With New ModelessMessageWindow
        .Init
        If windowProc = 0 Then
            tryCreate = True
        Else
            tryCreate = .tryAddSubclass(windowProc, data)
        End If
        Set outWindow = .Self
    End With
End Function

Public Property Get Self() As ModelessMessageWindow
    Set Self = Me
End Property

Public Sub Init()
    'Need to run this for window to be able to receive messages
    'Me.Show
    'Me.Hide
End Sub

Public Function tryAddSubclass(ByVal subclassProc As LongPtr, Optional ByVal data As LongPtr) As Boolean
        
    Dim instanceID As Long
    'Only let one instance of each subclassProc per windowHandle

    If this.subClassIDs.Exists(subclassProc) Then
        instanceID = this.subClassIDs(subclassProc)
    Else
        instanceID = this.subClassIDs.Count
        this.subClassIDs(subclassProc) = instanceID
    End If
    
    If WinAPI.SetWindowSubclass(handle, subclassProc, instanceID, data) Then
        tryAddSubclass = True
    End If
End Function

'@Description("Remove any registered subclasses - returns True if all removed successfully")
Public Function tryRemoveAllSubclasses() As Boolean
    
    Dim timerProc As Variant
    Dim result As Boolean
    result = True 'if no subclasses exist the we removed them nicely
    For Each timerProc In this.subClassIDs.Keys
        result = result And WinAPI.RemoveWindowSubclass(handle, timerProc, this.subClassIDs(timerProc)) <> 0
    Next timerProc
    this.subClassIDs.RemoveAll
    tryRemoveAllSubclasses = result
End Function

---

I've discovered that the problem is caused by a DoEvents statement, which allows a reset-button press to interrupt code execution (without DoEvents, the button press is queued after any code has finished executing, and just destroys the Userform as expected, triggering Windows to remove the subclasses cleanly). The same problematic behaviour can be simulated with the End statement:

Standard module: SubclassingTest

'@Folder("Tests.Experiments")
Option Explicit

Public Function subclassProc(ByVal hWnd As LongPtr, ByVal uMsg As WindowsMessage, ByVal wParam As LongPtr, ByVal lParam As LongPtr, ByVal uIdSubclass As LongPtr, ByVal dwRefData As LongPtr) As LongPtr
    Debug.Print "MSG #"; uMsg 'will this even print, or have we interrupted repainting the thread?
    subclassProc = WinAPI.DefSubclassProc(hWnd, uMsg, wParam, lParam)
End Function

Sub createWindow()
    'get window and subclass it
    Static messageWindow As ModelessMessageWindow 'so it hovers around in memory
    Debug.Print "Creating window"
    If Not ModelessMessageWindow.tryCreate(messageWindow, AddressOf subclassProc) Then
        Debug.Print "Couldn't get/subclass window"
        Exit Sub
    End If
End Sub

Sub nukeEverything()
    End
End Sub

After running createWindow, try pressing the reset button; it works fine and nothing crashes, and I get these messages printed:

MSG # 799 'WM_APPCOMMAND +3 - after createWindow but before pressing the button
MSG # 528 'WM_PARENTNOTIFY  
MSG # 144 'WM_MYSTERY +5 - IDK what this is
MSG # 2   'WM_DESTROY
MSG # 130 'WM_NCDESTROY

However if I instead run nukeEverything (or have a DoEvents loop providing an entry point for the reset button), I get a crash.

What I don't understand...

...is why ending stuff mid-execution (either with DoEvents allowing a reset button press through, or via the End statement) is different from the asynchronous approach. I've checked and the AddressOf the callback isn't affected by End*:

Sub checkPointer() 'always prints the same
    Debug.Print "Address: "; VBA.CLngPtr(AddressOf subclassProc)
    End
End Sub

i.e. the crash isn't the result of my SUBCLASSPROC function pointer becoming invalid. And of course End doesn't crash Excel when I'm not subclassing windows. So what exactly is causing the crash? Or is there a better approach (I know I can achieve very similar results using TIMERPROCS, but I'm curious to understand why this error is happening and so don't want to resort to those)

---

*It has been suggested in the comments that perhaps the function pointer just gets assigned the same address every time, making it appear to remain valid, but it is indeed being destroyed each time I run End and that's causing the crash (when Windows tries to invoke the SUBCLASSPROC). However I don't think this is true; if you create a timer with a TIMERPROC callback set, then pressing the reset button or running NukeEverything does not stop Windows continuing to run the callback. The callback function does remain valid between synchronous/asynchronous state losses, so I imagine my SUBCLASSPROC should too.

Answer 1

Waitting for answers