UnhookWinEvent does not unhook in VBA

I have an Excel workbook connected to Access. To help the user, a Windows Event Hook is set to return to the Excel workbook whenever the focus is set to Access while the Excel workbook is open.

The technique used follows the Stack Exchange solution described here.

For some installations, an

"Unexpected error (16777035)"

occurs. After further research, I have also determined the Windows User32 function UnhookWinEvent is failing to unhook the event. I am not certain the error and the unhook failure are related, but the unhook should be cleaned up anyway.

To demonstrate this, I created a minimal .accdb file with one form and one module. The form has a button that creates the event hook and then unhooks it. The module has the SetWinEventHook callback for hooked events. A variety of relevant information is displayed in the VBA Immediate window.

The code for the form is:

'Form frmEventHookTest

Option Compare Database
Option Explicit

Private Const strcModuleName = "basEventHook"
Private Const strcErrMsgTitle = strcModuleName & " Module Error"
Private Const strcMsgTitle = strcModuleName & " Module"

Private Const WINEVENT_OUTOFCONTEXT = 0

Private Declare Function SetWinEventHook Lib "user32.dll" (ByVal eventMin As Long _
      , ByVal eventMax As Long _
      , ByVal hmodWinEventProc As Long, ByVal pfnWinEventProc As Long, ByVal idProcess As Long _
      , ByVal idThread As Long, ByVal dwFlags As Long) As Long
Private Declare Function UnhookWinEvent Lib "user32.dll" ( _
      ByRef hWinEventHook As Long) As Long
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long

Private colRunningHandles As Collection
Public gblnEventHookGotFocus As Boolean

Private Sub cmdEventHook_Click()
   Const strcThisFunction = "cmdEventHook_Click"
   Dim lngThreadId As Long
   Dim lngEventHookId As Long
   Dim lngUnhookResult As Long
On Error GoTo Err_cmdEventHook_Click

   lngEventHookId = 0
   lngUnhookResult = 0
   lngThreadId = GetCurrentThreadId
   Debug.Print strcThisFunction + " hwnd: " + CStr(Application.hWndAccessApp) _
         + " Thread: " + CStr(lngThreadId)
   lngEventHookId = SetWinEventHook(EVENT_SYSTEM_FOREGROUND, EVENT_SYSTEM_FOREGROUND, 0& _
          , AddressOf WinEventFunc, 0, 0, WINEVENT_OUTOFCONTEXT)
   Debug.Print "StartEventHook Id: " + CStr(lngEventHookId)

   lngThreadId = GetCurrentThreadId
   If lngEventHookId <> 0 Then
      Debug.Print "Unhook Thread: " + CStr(lngThreadId) + " Hook Id: " + CStr(lngEventHookId)
      lngUnhookResult = UnhookWinEvent(lngEventHookId)
   End If 'lngEventHookId <> 0
   Debug.Print "Unhook result: " + CStr(lngUnhookResult)


Exit_cmdEventHook_Click:
   Exit Sub

Err_cmdEventHook_Click:
   MsgBox strcThisFunction + " " + CStr(Err.Number) + " " + Err.Description, vbCritical + vbOKOnly, strcModuleName
   Resume Exit_cmdEventHook_Click
End Sub

The code for the callback module is:

'Module basEventHook

Option Compare Database
Option Explicit

Private Const strcModuleName = "basEventHook"
Private Const strcErrMsgTitle = strcModuleName & " Module Error"
Private Const strcMsgTitle = strcModuleName & " Module"

Public Const EVENT_SYSTEM_FOREGROUND = &H3&

Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long _
      , lpdwProcessId As Long) As Long
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long

Public Function WinEventFunc(ByVal plngHookHandle As Long, ByVal plngEvent As Long, _
      ByVal plngHWnd As Long, ByVal plngIdObject As Long, ByVal plngIdChild As Long, _
      ByVal plngIdEventThread As Long, ByVal plngDwmsEventTime As Long) As Long
  'This function is a callback passed to the win32 api
  'We CANNOT throw an error or break. Bad things will happen.
   Const strcThisFunction = "WinEventFunc"
   Dim lngCurrentProcId As Long
   Dim lngWinThreadProcId As Long
   Dim lngPid As Long
On Error Resume Next

   If plngEvent = EVENT_SYSTEM_FOREGROUND Then
      lngWinThreadProcId = GetWindowThreadProcessId(plngHWnd, lngPid)
      lngCurrentProcId = GetCurrentProcessId
      Debug.Print "Hook handle: " + CStr(plngHookHandle) + " WinThreadHWnd: " + CStr(plngHWnd) _
            + " Pid: " + CStr(lngPid) + " WinThreadProcId: " + CStr(lngWinThreadProcId) _
            + ", curPid: " + CStr(lngCurrentProcId)
   End If 'plngEvent = EVENT_SYSTEM_FOREGROUND

Exit_WinEventFunc:
On Error GoTo 0
   Exit Function
End Function

The results of clicking on the cmdEventHook button are:

cmdEventHook_Click hwnd: 2034428 Thread: 9284
StartEventHook Id: 234686679
Unhook Thread: 9284 Hook Id: 234686679
Unhook result: 0

Hook handle: 234686679 WinThreadHWnd: 2230772 Pid: 7208 WinThreadProcId: 9284, curPid: 7208

The unhook result of 0 indicates a failure to unhook. MS UnhookWinEvent function documentation says the main reasons for failure are:

The hWinEventHook parameter is NULL or not valid.

The event hook specified by hWinEventHook was already removed.

UnhookWinEvent is called from a thread that is different from the original call to SetWinEventHook.

I believe all of these are fulfilled, so I really don't understand why the event is not unhooked?

Anyone have ideas?

Thanks... Lindsay

Recommended topics

Hot tags