API mouse hook

[footoo]

I've been using the code below for many years without problems.
I have just installed Windows 11 and Office 365 and now the code does not work.
It produces a type mismatch error for the code highlighted in red (AddressOf MouseProc)
I know nothing about API code.
Would much appreciate help.

Sub HookListBoxScroll()
Dim lngAppInst As Long
Dim hwndUnderCursor As Long
Dim tPT As POINTAPI
GetCursorPos tPT
hwndUnderCursor = WindowFromPoint(tPT.x, tPT.y)
If mListBoxHwnd <> hwndUnderCursor Then
    UnhookListBoxScroll
    mListBoxHwnd = hwndUnderCursor
    lngAppInst = GetWindowLong(mListBoxHwnd, GWL_HINSTANCE)
    PostMessage mListBoxHwnd, WM_LBUTTONDOWN, 0&, 0&
    If Not mbHook Then
        mLngMouseHook = SetWindowsHookEx( _
            WH_MOUSE_LL,[COLOR=rgb(226, 80, 65)] AddressOf MouseProc[/COLOR], lngAppInst, 0)
        mbHook = mLngMouseHook <> 0
    End If
End If
End Sub
Sub UnhookListBoxScroll()
If mbHook Then
    UnhookWindowsHookEx mLngMouseHook
    mLngMouseHook = 0
    mListBoxHwnd = 0
    mbHook = False
End If
End Sub
Private Function MouseProc( _
    ByVal nCode As Long, ByVal wParam As Long, _
    ByRef lParam As MOUSEHOOKSTRUCT) As Long
On Error GoTo errH    'Resume Next
If (nCode = HC_ACTION) Then
    If WindowFromPoint(lParam.pt.x, lParam.pt.y) = mListBoxHwnd Then
        If wParam = WM_MOUSEWHEEL Then
            MouseProc = True
            If lParam.hwnd > 0 Then
                PostMessage mListBoxHwnd, WM_KEYDOWN, VK_UP, 0
            Else
                PostMessage mListBoxHwnd, WM_KEYDOWN, VK_DOWN, 0
            End If
            PostMessage mListBoxHwnd, WM_KEYUP, VK_UP, 0
            Exit Function
        End If
    Else
        UnhookListBoxScroll
    End If
End If
MouseProc = CallNextHookEx(mLngMouseHook, nCode, wParam, ByVal lParam)
Exit Function
errH:
UnhookListBoxScroll
End Function

 

[footoo]

Try : lngAppInst = GetWindowLongPtr(mListBoxHwnd, GWL_HINSTANCE)

This works for me :

Option Explicit

Private Type POINTAPI
    XY As LongLong
End Type

Private Type MOUSEHOOKSTRUCT
    Pt As POINTAPI
    hWnd As Long
    wHitTestCode As Long
    dwExtraInfo As Long
End Type

Private Declare PtrSafe Function GetWindowLongPtr Lib "user32" _
    Alias "GetWindowLongPtrA" ( _
        ByVal hWnd As LongPtr, _
        ByVal nIndex As Long) 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 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 hHook As LongPtr) As LongPtr ' MAYBE Long
Private Declare PtrSafe Function WindowFromPoint Lib "user32" ( _
        ByVal Point As LongLong) As LongPtr    '
Private Declare PtrSafe Function GetCursorPos Lib "user32" ( _
        ByRef lpPoint As POINTAPI) As LongPtr   'MAYBE Long

Private Const WH_MOUSE_LL As Long = 14
Private Const WM_MOUSEWHEEL As Long = &H20A
Private Const HC_ACTION As Long = 0
Private Const GWL_HINSTANCE As Long = (-6)
Dim n As Long
Private mCtl As Object
Private mbHook As Boolean

'******************************************
'******************************************
Const scrollOnly As Boolean = True ' set to False to actually move selection when scrolling mouse wheel
'******************************************
'******************************************

Private mLngMouseHook As LongPtr
Private mListBoxHwnd As LongPtr

Sub HookListBoxScroll(frm As Object, ctl As Object)
Dim tPT As POINTAPI
Dim lngAppInst As LongPtr
Dim hwndUnderCursor As LongPtr
GetCursorPos tPT
hwndUnderCursor = WindowFromPoint(tPT.XY)
If TypeOf ctl Is UserForm Then
    If Not frm Is ctl Then
        ctl.SetFocus
    End If
Else
    If Not frm.ActiveControl Is ctl Then
        ctl.SetFocus
    End If
End If
If mListBoxHwnd <> hwndUnderCursor Then
    UnhookListBoxScroll
    Set mCtl = ctl
    mListBoxHwnd = hwndUnderCursor
    lngAppInst = GetWindowLongPtr(mListBoxHwnd, GWL_HINSTANCE)
    'PostMessage mListBoxHwnd, WM_LBUTTONDOWN, 0&, 0&
    If Not mbHook Then
        mLngMouseHook = SetWindowsHookEx( _
            WH_MOUSE_LL, AddressOf MouseProc, lngAppInst, 0)
        mbHook = mLngMouseHook <> 0
    End If
End If
End Sub

Sub UnhookListBoxScroll()
If mbHook Then
    Set mCtl = Nothing
    UnhookWindowsHookEx mLngMouseHook
    mLngMouseHook = 0
    mListBoxHwnd = 0
    mbHook = False
End If
End Sub

#If VBA7 Then
Private Function MouseProc( _
    ByVal nCode As Long, ByVal wParam As Long, _
    ByRef lParam As MOUSEHOOKSTRUCT) As LongPtr
Dim idx As Long
On Error GoTo errH
If (nCode = HC_ACTION) Then
    If WindowFromPoint(lParam.Pt.XY) = mListBoxHwnd Then
        If wParam = WM_MOUSEWHEEL Then
            MouseProc = True
            If TypeOf mCtl Is Frame Then
                If lParam.hWnd > 0 Then idx = -10 Else idx = 10
                idx = idx + mCtl.ScrollTop
                If idx >= 0 And idx < ((mCtl.ScrollHeight - mCtl.Height) + 17.25) Then
                    mCtl.ScrollTop = idx
                End If
            ElseIf TypeOf mCtl Is UserForm Then
                If lParam.hWnd > 0 Then idx = -10 Else idx = 10
                idx = idx + mCtl.ScrollTop
                If idx >= 0 And idx < ((mCtl.ScrollHeight - mCtl.Height) + 17.25) Then
                    mCtl.ScrollTop = idx
                End If
            Else
                If lParam.hWnd > 0 Then idx = -1 Else idx = 1
                '*************** MAKE scrollOnly False IF YOU WANT TO CHANGE THE SELECTION RATHER THAN JUST SCROLL ******
                If scrollOnly Then
                    idx = idx + mCtl.TopIndex
                    If idx >= 0 Then mCtl.TopIndex = idx
                Else
                    idx = idx + mCtl.ListIndex
                    If idx >= 0 Then mCtl.ListIndex = idx
                End If
                '*********************************************************************************************************
            End If
            Exit Function
        End If
    Else
        UnhookListBoxScroll
    End If
End If
MouseProc = CallNextHookEx( _
                        mLngMouseHook, nCode, wParam, ByVal lParam)
Exit Function
errH:
UnhookListBoxScroll
End Function
#End If

 

[JEFFAGLA]

i get an argument is not optional on the below call for Hooklistboxscroll

Private Sub lstdatabase_MouseMove( _
ByVal Button As Integer, ByVal Shift As Integer, _
ByVal x As Single, ByVal y As Single)
' start the hook
HookListBoxScroll
IsHooked = True
End Sub

 

[footoo]

I use this :

Private Sub ListBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
On Error Resume Next
HookListBoxScroll Me, Me.ListBox1
On Error GoTo 0
End Sub

Did you try the code I posted?
I don't know API coding so cannot be much help.

 

[JEFFAGLA]

yes i used what you sent along with this - ran into another small issue i resolved to thanks again. It does however crash occasionally and it appears to have removed the scroll bars in excel which is odd.

 

[footoo]

I had a problem with Excel crashing when the user form was open at the same time as the VBE was open, and the mouse scroll was used on the user form.
I worked around this by using a macro to open the VBE. The macro contains code to close the user form, if it is open :

Sub Go_to_VBE()
Dim maxW%: maxW = 1452
Dim wdth: wdth = 950
With Application.VBE.MainWindow
    If .Visible = False Then
        .Visible = True
        .Height = 800
        .Width = wdth
        .Top = 120
        .Left = maxW / 2 - wdth / 15
    Else: .WindowState = 0
    End If
    .SetFocus
End With

If Workbooks("Select Personal Macros (User Form).xlsb") _
    .Worksheets("Personal Macros").[A1] = "Form Loaded" Then _
    Application.Run "'Select Personal Macros (User Form).xlsb'!Unload_PersonalMacros"
End Sub

Also, in the procedure to open the user form, close the VBE with this :

With Application.VBE.MainWindow
    If .Visible = True Then .Visible = False
End With