Option Compare Text
Option Explicit

Public CMouse As CMouseWheel
Declare Function SetWindowLong Lib  "user32"  Alias  "SetWindowLongA"  _
    (ByVal hwnd As Long, _
    ByVal nIndex As Long, _
    ByVal dwNewLong As Long) As Long

Public 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
     
Public Const GWL_WNDPROC = - 4 
Public Const WM_MouseWheel = &H20A
Public lpPrevWndProc As Long
Public Function WindowProc(ByVal hwnd As Long, _
    ByVal uMsg As Long, _
    ByVal wParam As Long, _
    ByVal lParam As Long) As Long
    Select Case uMsg
        Case WM_MouseWheel
            CMouse.FireMouseWheel
            If CMouse.MouseWheelCancel = False Then
                WindowProc = CallWindowProc(lpPrevWndProc, hwnd, uMsg, wParam, lParam)
            End If
            
        Case Else
           WindowProc = CallWindowProc(lpPrevWndProc, hwnd, uMsg, wParam, lParam)
    End Select
End Function

Option Compare Text
Option Explicit

Private frm As Object
Private intCancel As Integer
Public Event MouseWheel(Cancel As Integer)

Public Property Set Form(frmIn As Object)
    Set frm = frmIn
End Property

Public Property Get MouseWheelCancel() As Integer
    MouseWheelCancel = intCancel
End Property

Public Sub SubClassHookForm()
    lpPrevWndProc = SetWindowLong(frm.hwnd, GWL_WNDPROC, _
                                    AddressOf WindowProc)
      Set CMouse = Me
   End Sub

Public Sub SubClassUnHookForm()
    Call SetWindowLong(frm.hwnd, GWL_WNDPROC, lpPrevWndProc)
End Sub

Public Sub FireMouseWheel()
    RaiseEvent MouseWheel(intCancel)
End Sub

Option Compare Database
Option Explicit

Private WithEvents clsMouseWheel As CMouseWheel

Private Sub Form_Load()
    Set clsMouseWheel = New CMouseWheel
    Set clsMouseWheel.Form = Me
    clsMouseWheel.SubClassHookForm
End Sub

Private Sub Form_Close()
   clsMouseWheel.SubClassUnHookForm
   Set clsMouseWheel.Form = Nothing
   Set clsMouseWheel = Nothing
End Sub

Private Sub clsMouseWheel_MouseWheel(Cancel As Integer)
    MsgBox  "You cannot use the mouse wheel to scroll records." 
    Cancel = True
End Sub