"SetWindowsHookEx" Crashing Excel x64

[carlobatusi]

Hello. For a while I've been using the MsgBoxCB sub from Dan Elgaard (www.EXCELGAARD.dk) in order to have message boxes with custom button text. Up until now I have been using Excel 2007-2019 x32 and everything has been working perfectly.

Recently I started testing my application on Excel 2016 x64 and Excel 2019 x64 and suddenly I am getting random crashes when using MsgBoxCB. After doing some debugging I have narrowed down the cause of the crashes to the line "SetWindowsHookEx". I've tried to research this problem online but I could not find any solutions that solved my crashes and I'm at a bit of a loss right now. Below is the code for the MsgBoxCB. Any help would be appreciated.

' (C) Dan Elgaard (www.EXCELGAARD.dk)

' MsgBox Buttons/Answers ID Constants
  Private Const MsgBox_Button_ID_OK     As Long = 1
  Private Const MsgBox_Button_ID_Cancel As Long = 2
  Private Const MsgBox_Button_ID_Abort  As Long = 3
  Private Const MsgBox_Button_ID_Retry  As Long = 4
  Private Const MsgBox_Button_ID_Ignore As Long = 5
  Private Const MsgBox_Button_ID_Yes    As Long = 6
  Private Const MsgBox_Button_ID_No     As Long = 7

' MsgBox Buttons/Answers Text Variables
  Private MsgBox_Button_Text_OK         As String
  Private MsgBox_Button_Text_Cancel     As String
  Private MsgBox_Button_Text_Abort      As String
  Private MsgBox_Button_Text_Retry      As String
  Private MsgBox_Button_Text_Ignore     As String
  Private MsgBox_Button_Text_Yes        As String
  Private MsgBox_Button_Text_No         As String

' Handle to the Hook procedure
 #If VBA7 Then
      Private MsgBoxHookHandle          As LongPtr                                        ' 64-bit handle
 #Else
      Private MsgBoxHookHandle          As Long
 #End If

' Windows API functions
 #If VBA7 Then
      Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As LongPtr
      Private Declare PtrSafe Function SetDlgItemText Lib "user32" Alias "SetDlgItemTextA" (ByVal hDlg As LongPtr, ByVal nIDDlgItem As LongPtr, ByVal lpString As String) As LongPtr
      Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As LongPtr, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As LongPtr) As LongPtr     
      Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As LongPtr
 #Else
      Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
      Private Declare Function SetDlgItemText Lib "user32" Alias "SetDlgItemTextA" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal lpString As String) 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 UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
 #End If

Option Private Module                                                                     ' To prevent the function(s) from appearing the worksheet list of functions (it's a 'for macros only' function)
Option Explicit
    Function MsgBoxCB(MsgBox_Text As String, Button1 As String, Optional Button2 As String, Optional Button3 As String, Optional MsgBox_Icon As Long, Optional MsgBox_Title As String) As Long     

' * ' Initialize
      On Error Resume Next


' * ' Define variables
      If Button1 = vbNullString Then
            Button1 = Button2
            Button2 = vbNullString
      End If
      If Button2 = vbNullString Then
            Button2 = Button3
            Button3 = vbNullString
      End If

      Dim ButtonsToUse As Long
      ButtonsToUse = vbAbortRetryIgnore
      If Button3 = vbNullString Then ButtonsToUse = vbYesNo
      If Button2 = vbNullString Then ButtonsToUse = vbOKOnly

      Select Case MsgBox_Icon
            Case vbCritical:        ButtonsToUse = ButtonsToUse + MsgBox_Icon
            Case vbExclamation:     ButtonsToUse = ButtonsToUse + MsgBox_Icon
            Case vbInformation:     ButtonsToUse = ButtonsToUse + MsgBox_Icon
            Case vbQuestion:        ButtonsToUse = ButtonsToUse + MsgBox_Icon
      End Select

      If MsgBox_Title = vbNullString Then MsgBox_Title = " Microsoft Excel"               ' Default MsgBox title

      Dim MsgBoxAnswer As Long


' * ' Set custom buttons texts
      MsgBox_Button_Text_OK     = Button1
      MsgBox_Button_Text_Cancel = vbNullString                                            ' Not used
      MsgBox_Button_Text_Abort  = Button1
      MsgBox_Button_Text_Retry  = Button2
      MsgBox_Button_Text_Ignore = Button3
      MsgBox_Button_Text_Yes    = Button1
      MsgBox_Button_Text_No     = Button2

      MsgBoxHookHandle = SetWindowsHookEx(5, AddressOf MsgBoxHook, 0, GetCurrentThreadId) ' Set MsgBox Hook


' * ' Show hooked MsgBox
      MsgBoxAnswer = MsgBox(MsgBox_Text, ButtonsToUse, MsgBox_Title)


EF: ' End of Function
      UnhookWindowsHookEx MsgBoxHookHandle                                                ' Unhook MsgBox again

      Select Case MsgBoxAnswer
            Case vbOK:        MsgBoxCB = 1
            Case vbCancel:    MsgBoxCB = 0                                                ' Not used
            Case vbAbort:     MsgBoxCB = 1
            Case vbRetry:     MsgBoxCB = 2
            Case vbIgnore:    MsgBoxCB = 3
            Case vbYes:       MsgBoxCB = 1
            Case vbNo:        MsgBoxCB = 2
      End Select

End Function
     #If VBA7 Then
      Private Function MsgBoxHook(ByVal LM As LongPtr, ByVal WP As LongPtr, ByVal LP As LongPtr) As LongPtr
            SetDlgItemText WP, MsgBox_Button_ID_OK,     MsgBox_Button_Text_OK
            SetDlgItemText WP, MsgBox_Button_ID_Cancel, MsgBox_Button_Text_Cancel         ' Not used
            SetDlgItemText WP, MsgBox_Button_ID_Abort,  MsgBox_Button_Text_Abort
            SetDlgItemText WP, MsgBox_Button_ID_Retry,  MsgBox_Button_Text_Retry
            SetDlgItemText WP, MsgBox_Button_ID_Ignore, MsgBox_Button_Text_Ignore
            SetDlgItemText WP, MsgBox_Button_ID_Yes,    MsgBox_Button_Text_Yes
            SetDlgItemText WP, MsgBox_Button_ID_No,     MsgBox_Button_Text_No
      End Function
 #Else
      Private Function MsgBoxHook(ByVal LM As Long, ByVal WP As Long, ByVal LP As Long) As Long
            SetDlgItemText WP, MsgBox_Button_ID_OK,     MsgBox_Button_Text_OK
            SetDlgItemText WP, MsgBox_Button_ID_Cancel, MsgBox_Button_Text_Cancel         ' Not used
            SetDlgItemText WP, MsgBox_Button_ID_Abort,  MsgBox_Button_Text_Abort
            SetDlgItemText WP, MsgBox_Button_ID_Retry,  MsgBox_Button_Text_Retry
            SetDlgItemText WP, MsgBox_Button_ID_Ignore, MsgBox_Button_Text_Ignore
            SetDlgItemText WP, MsgBox_Button_ID_Yes,    MsgBox_Button_Text_Yes
            SetDlgItemText WP, MsgBox_Button_ID_No,     MsgBox_Button_Text_No
      End Function
 #End If

 

[RoryA]

Your 64bit declarations are incorrect.

#If VBA7 Then
Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
Private Declare PtrSafe Function SetDlgItemText Lib "user32" Alias "SetDlgItemTextA" (ByVal hDlg As LongPtr, ByVal nIDDlgItem As Long, ByVal lpString As String) As Long
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 UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As Long

You don't simply make all Long variables into LongPtr.

​

 

[Jon Peltier]

Thanks Rory. I was using SetWindowsHookEx with a couple mistyped arguments. Never caused a problem until a recent update to Office or Windows, I don't know which. But now it's cool. Thanks to Google for finding your post above.

 

[RoryA]

Glad to help, Jon.