Excel 键盘挂钩不工作？KeyboardProc回调函数未执行？

编辑以下评论：

lpfn

类型：HOOKPROC

指向钩子过程的指针。如果dwThreadId参数为零或指定由其他进程创建的线程的标识符，则lpfn参数必须指向DLL中的挂钩过程。否则，lpfn可以指向与当前进程关联的代码中的钩子过程

hmod

类型：HINSTANCE

包含lpfn参数指向的钩子过程的DLL句柄。如果dwThreadId参数指定由当前进程创建的线程，并且钩子过程位于与当前进程关联的代码内，则必须将hMod参数设置为NULL

---

我不明白这为什么不起作用。对于这个版本，我不阻止任何挂钩。我只需在txt文件中输入，记下键盘回调函数处理该消息的时间。然而，当我通过我的主程序一步，钩子捕捉OK。但我认为KeyboardCallBack永远不会执行，因为我的日志对于它的初始头是空的

常量和API:

Private Declare PtrSafe 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 PtrSafe Sub CopyMemory Lib "kernel32" _
   Alias "RtlMoveMemory" _
  (pDest As Any, _
   pSource As Any, _
   ByVal cb As Long)

Private Declare PtrSafe Function CallNextHookEx Lib "user32" _
   (ByVal hHook As Long, _
   ByVal nCode As Long, _
   ByVal wParam As Long, _
   ByVal lParam As Long) As Long

Private Type KBDLLHOOKSTRUCT
  vkCode As Long
  scanCode As Long
  flags As Long
  time As Long
  dwExtraInfo As Long
End Type

Private Const HC_ACTION = 0
Private Const WH_KEYBOARD_LL = 13&
Private KeyboardHandle As Long

Public Sub HookKeyboard()
    KeyboardHandle = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf KeyboardCallback, Application.Hinstance, 0)
End Sub

Public Function KeyboardCallback(ByVal Code As Long, _
                                  ByVal wParam As Long, _
                                  ByVal lParam As Long) As Long
    Call TimeStamp
    Static Hookstruct As KBDLLHOOKSTRUCT

    If Code = HC_ACTION Then
        Call CopyMemory(Hookstruct, ByVal lParam, Len(Hookstruct))
        If BlockKey(Hookstruct) = True Then
            KeyboardCallback = 1
            Exit Function
        End If
    End If

  KeyboardCallback = CallNextHookEx(KeyboardHandle, _
    Code, wParam, lParam)
End Function

    Private Function BlockKey(ByRef Hookstruct As KBDLLHOOKSTRUCT) As Boolean
        BlockKey = False
    End Function

    Private Function TimeStamp()
        Dim FSO As Object
        Set FSO = CreateObject("Scripting.FileSystemObject")

        Dim TSO As Object
        Set TSO = FSO.OpenTextFile("C:\Users\evanm\Desktop\New Text Document.txt", 1)

        Dim FileString As String
        FileString = TSO.ReadAll
        TSO.Close

        FileString = FileString & " " & Now() & " "

        Set TSO = FSO.OpenTextFile("C:\Users\evanm\Desktop\New Text Document.txt", 2)
        TSO.WriteLine FileString
        TSO.Close

        Set FSO = Nothing
        Set TSO = Nothing
    End Function

Sub testHook()
    Hook.HookKeyboard
Stop
'write a bunch of stuff
Stop
    Hook.UnhookKeyboard
End Sub

Sub testWriteFile()
    Hook.TimeStamp
End Sub

钩子：

Private Declare PtrSafe 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 PtrSafe Sub CopyMemory Lib "kernel32" _
   Alias "RtlMoveMemory" _
  (pDest As Any, _
   pSource As Any, _
   ByVal cb As Long)

Private Declare PtrSafe Function CallNextHookEx Lib "user32" _
   (ByVal hHook As Long, _
   ByVal nCode As Long, _
   ByVal wParam As Long, _
   ByVal lParam As Long) As Long

Private Type KBDLLHOOKSTRUCT
  vkCode As Long
  scanCode As Long
  flags As Long
  time As Long
  dwExtraInfo As Long
End Type

Private Const HC_ACTION = 0
Private Const WH_KEYBOARD_LL = 13&
Private KeyboardHandle As Long

Public Sub HookKeyboard()
    KeyboardHandle = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf KeyboardCallback, Application.Hinstance, 0)
End Sub

Public Function KeyboardCallback(ByVal Code As Long, _
                                  ByVal wParam As Long, _
                                  ByVal lParam As Long) As Long
    Call TimeStamp
    Static Hookstruct As KBDLLHOOKSTRUCT

    If Code = HC_ACTION Then
        Call CopyMemory(Hookstruct, ByVal lParam, Len(Hookstruct))
        If BlockKey(Hookstruct) = True Then
            KeyboardCallback = 1
            Exit Function
        End If
    End If

  KeyboardCallback = CallNextHookEx(KeyboardHandle, _
    Code, wParam, lParam)
End Function

    Private Function BlockKey(ByRef Hookstruct As KBDLLHOOKSTRUCT) As Boolean
        BlockKey = False
    End Function

    Private Function TimeStamp()
        Dim FSO As Object
        Set FSO = CreateObject("Scripting.FileSystemObject")

        Dim TSO As Object
        Set TSO = FSO.OpenTextFile("C:\Users\evanm\Desktop\New Text Document.txt", 1)

        Dim FileString As String
        FileString = TSO.ReadAll
        TSO.Close

        FileString = FileString & " " & Now() & " "

        Set TSO = FSO.OpenTextFile("C:\Users\evanm\Desktop\New Text Document.txt", 2)
        TSO.WriteLine FileString
        TSO.Close

        Set FSO = Nothing
        Set TSO = Nothing
    End Function

Sub testHook()
    Hook.HookKeyboard
Stop
'write a bunch of stuff
Stop
    Hook.UnhookKeyboard
End Sub

Sub testWriteFile()
    Hook.TimeStamp
End Sub

键盘回调和辅助功能：

Private Declare PtrSafe 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 PtrSafe Sub CopyMemory Lib "kernel32" _
   Alias "RtlMoveMemory" _
  (pDest As Any, _
   pSource As Any, _
   ByVal cb As Long)

Private Declare PtrSafe Function CallNextHookEx Lib "user32" _
   (ByVal hHook As Long, _
   ByVal nCode As Long, _
   ByVal wParam As Long, _
   ByVal lParam As Long) As Long

Private Type KBDLLHOOKSTRUCT
  vkCode As Long
  scanCode As Long
  flags As Long
  time As Long
  dwExtraInfo As Long
End Type

Private Const HC_ACTION = 0
Private Const WH_KEYBOARD_LL = 13&
Private KeyboardHandle As Long

Public Sub HookKeyboard()
    KeyboardHandle = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf KeyboardCallback, Application.Hinstance, 0)
End Sub

Public Function KeyboardCallback(ByVal Code As Long, _
                                  ByVal wParam As Long, _
                                  ByVal lParam As Long) As Long
    Call TimeStamp
    Static Hookstruct As KBDLLHOOKSTRUCT

    If Code = HC_ACTION Then
        Call CopyMemory(Hookstruct, ByVal lParam, Len(Hookstruct))
        If BlockKey(Hookstruct) = True Then
            KeyboardCallback = 1
            Exit Function
        End If
    End If

  KeyboardCallback = CallNextHookEx(KeyboardHandle, _
    Code, wParam, lParam)
End Function

    Private Function BlockKey(ByRef Hookstruct As KBDLLHOOKSTRUCT) As Boolean
        BlockKey = False
    End Function

    Private Function TimeStamp()
        Dim FSO As Object
        Set FSO = CreateObject("Scripting.FileSystemObject")

        Dim TSO As Object
        Set TSO = FSO.OpenTextFile("C:\Users\evanm\Desktop\New Text Document.txt", 1)

        Dim FileString As String
        FileString = TSO.ReadAll
        TSO.Close

        FileString = FileString & " " & Now() & " "

        Set TSO = FSO.OpenTextFile("C:\Users\evanm\Desktop\New Text Document.txt", 2)
        TSO.WriteLine FileString
        TSO.Close

        Set FSO = Nothing
        Set TSO = Nothing
    End Function

Sub testHook()
    Hook.HookKeyboard
Stop
'write a bunch of stuff
Stop
    Hook.UnhookKeyboard
End Sub

Sub testWriteFile()
    Hook.TimeStamp
End Sub

测试：

Private Declare PtrSafe 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 PtrSafe Sub CopyMemory Lib "kernel32" _
   Alias "RtlMoveMemory" _
  (pDest As Any, _
   pSource As Any, _
   ByVal cb As Long)

Private Declare PtrSafe Function CallNextHookEx Lib "user32" _
   (ByVal hHook As Long, _
   ByVal nCode As Long, _
   ByVal wParam As Long, _
   ByVal lParam As Long) As Long

Private Type KBDLLHOOKSTRUCT
  vkCode As Long
  scanCode As Long
  flags As Long
  time As Long
  dwExtraInfo As Long
End Type

Private Const HC_ACTION = 0
Private Const WH_KEYBOARD_LL = 13&
Private KeyboardHandle As Long

Public Sub HookKeyboard()
    KeyboardHandle = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf KeyboardCallback, Application.Hinstance, 0)
End Sub

Public Function KeyboardCallback(ByVal Code As Long, _
                                  ByVal wParam As Long, _
                                  ByVal lParam As Long) As Long
    Call TimeStamp
    Static Hookstruct As KBDLLHOOKSTRUCT

    If Code = HC_ACTION Then
        Call CopyMemory(Hookstruct, ByVal lParam, Len(Hookstruct))
        If BlockKey(Hookstruct) = True Then
            KeyboardCallback = 1
            Exit Function
        End If
    End If

  KeyboardCallback = CallNextHookEx(KeyboardHandle, _
    Code, wParam, lParam)
End Function

    Private Function BlockKey(ByRef Hookstruct As KBDLLHOOKSTRUCT) As Boolean
        BlockKey = False
    End Function

    Private Function TimeStamp()
        Dim FSO As Object
        Set FSO = CreateObject("Scripting.FileSystemObject")

        Dim TSO As Object
        Set TSO = FSO.OpenTextFile("C:\Users\evanm\Desktop\New Text Document.txt", 1)

        Dim FileString As String
        FileString = TSO.ReadAll
        TSO.Close

        FileString = FileString & " " & Now() & " "

        Set TSO = FSO.OpenTextFile("C:\Users\evanm\Desktop\New Text Document.txt", 2)
        TSO.WriteLine FileString
        TSO.Close

        Set FSO = Nothing
        Set TSO = Nothing
    End Function

Sub testHook()
    Hook.HookKeyboard
Stop
'write a bunch of stuff
Stop
    Hook.UnhookKeyboard
End Sub

Sub testWriteFile()
    Hook.TimeStamp
End Sub

---

根据，

Application.Hinstance

仅返回32位主机中的有效指针。您是否尝试过

应用程序.HinstancePtr

？也就是说，我会先尝试

Application.Hwnd

（主窗口句柄）。低级键盘挂钩可能在Office主机中不起作用。IIR Office会干扰键盘状态，因此，如果在Office之前没有将钩子放入链中，那么您在回调中最终得到的KBDLLHOOKSTRUCT是否有效将是命中或未命中的问题..Hwnd并且钩子未捕获。HinstancePTR和HInstance都被捕获了，但是我的键盘回调没有执行。同样，VBA是单线程的，这使得在VBA中进行任何多线程处理都有点困难。它不是一个文件，您只需注册一个回调过程。如果使用VBA之外定义的stuct，则在尝试解除钩住它或运行时停止执行时，将发生访问冲突。Per，

Application.Hinstance

仅返回32位主机中的有效指针。您是否尝试过

应用程序.HinstancePtr

？也就是说，我会先尝试

Application.Hwnd

（主窗口句柄）。低级键盘挂钩可能在Office主机中不起作用。IIR Office会干扰键盘状态，因此，如果在Office之前没有将钩子放入链中，那么您在回调中最终得到的KBDLLHOOKSTRUCT是否有效将是命中或未命中的问题..Hwnd并且钩子未捕获。HinstancePTR和HInstance都被捕获了，但是我的键盘回调没有执行。同样，VBA是单线程的，这使得在VBA中进行任何多线程处理都有点困难。它不是一个文件，您只需注册一个回调过程。如果使用在VBA之外定义的stuct，则在尝试取消挂钩或运行时停止执行时，将出现访问冲突。