Option Explicit
Private lTimerID As Long
Public Event KeyboardChanged(lKey As Long)
Public Sub Keyboard_StartWatching(Optional WatchCycle As Long = 100)
lTimerID = SetTimer(0&, 0&, WatchCycle, AddressOf TimerCallBack)
ADD_Cb Me, lTimerID
End Sub
Public Sub Keyboard_StopWatching()
KillTimer 0, lTimerID
REM_Cb lTimerID
lTimerID = -1
End Sub
Friend Function CheckKeyboardState()
Dim lKey As Long
' hier wird das Keyboard abgefragt
' .... dein Code ....
' lKey=gedrückte Taste
' wenn sich etwas ändert, dann werfen wir das Event
 
' nur dummy
lKey = 4711
RaiseEvent KeyboardChanged(lKey)
End Function
Private Sub Class_Initialize()
lTimerID = -1
End Sub
Private Sub Class_Terminate()
If lTimerID > 0 Then
   KillTimer 0, lTimerID
   lTimerID = -1
End If
End Sub

Option Explicit
Public Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal _
  nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal _
nIDEvent As Long) As Long
Private mTimerID2Caller As Collection
Public Sub ADD_Cb(ByVal Caller As Object, ByVal TimerID As Long)
On Error Resume Next
If mTimerID2Caller Is Nothing Then Set mTimerID2Caller = New Collection
mTimerID2Caller.Add Caller, "ID" & CStr(TimerID)
On Error GoTo 0
End Sub
Public Sub REM_Cb(ByVal TimerID As Long)
On Error Resume Next
mTimerID2Caller.Remove "ID" & CStr(TimerID)
If mTimerID2Caller.Count = 0 Then Set mTimerID2Caller = Nothing
On Error GoTo 0
End Sub
Public Sub TimerCallBack(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idEvent _
  As Long, ByVal dwTime As Long)
On Error Resume Next
Dim mCb As cKeyboard
Set mCb = mTimerID2Caller.Item("ID" & CStr(idEvent))
If mCb Is Nothing Then
   Exit Sub
End If
mCb.CheckKeyboardState
Set mCb = Nothing
On Error GoTo 0
End Sub

Option Explicit
Private lCalls As Long
Private WithEvents Keyboard As cKeyboard
Private Sub cmdStart_Click()
lCalls = 0
Keyboard.Keyboard_StartWatching 100
End Sub
Private Sub cmdStop_Click()
Keyboard.Keyboard_StopWatching
End Sub
 
Private Sub Form_Load()
Set Keyboard = New cKeyboard
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set Keyboard = Nothing
End Sub
Private Sub Keyboard_KeyboardChanged(lKey As Long)
' nur Dummy, damit man sieht das etwas passiert
lCalls = lCalls + 1
lblCalls.Caption = "Aufrufe: " & CStr(lCalls)
End Sub