VBA / API Keyboard Events w/ Caps Lock & Shift Key - api

Question

Objective:To make a program which tracks the users keystrokes and displays them in cell(1,1).
Issue: Solved
Code: See below for a working copy.
Code included key press for:
Shift Key,
Caps Lock,
Spacebar,
Backspace &
Esc

Answer 1

A Working example:
Option Explicit
Option Compare Text
Private Type POINTAPI
x As Long
Y As Long
End Type
Private Type MSG
hwnd As Long
Message As Long
wParam As Long
lParam As Long
time As Long
pt As POINTAPI
End Type
Private Type KeyboardBytes
kbByte(0 To 255) As Byte
End Type
Dim KB_Array As KeyboardBytes 'WAS kbArray
Const VK_BACK As Long = &H8 '= 8
Const VK_TAB As Long = &H9 '= 9
Const VK_RETURN As Long = &HD '= 13
Const VK_SHIFT As Long = &H10 '= 16
Const VK_CAPITAL As Long = &H14 '=20
Const VK_ESC As Long = &H1B '= 27
Const VK_SPACE As Long = &H20 '= 32
Const WM_KEYDOWN As Long = &H100 'for PeekMessage
Const PM_REMOVE As Long = &H1 'for PeekMessage
Const KEY_MASK As Integer = &HFF80 ' decimal -128
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal nVirtKey As Integer) As Integer
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetKeyboardState Lib "user32" (KB_Array As KeyboardBytes) As Long
Private Declare Function SetKeyboardState Lib "user32" (KB_Array As KeyboardBytes) As Long
Private Declare Function WaitMessage Lib "user32" () As Long
Private Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" _
(ByRef lpMsg As MSG, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
Sub woops()
Dim msgMessage As MSG, iKeyCode As Long, lXLhwnd As Long, aString As String
Dim aExit As Boolean, CapsLock_On As Boolean, ShiftKey_On As Boolean
AppActivate "Microsoft Excel"
Cells(1, 1) = ""
lXLhwnd = FindWindow("XLMAIN", Application.Caption)
GetKeyboardState KB_Array
CapsLock_On = IIf(KB_Array.kbByte(VK_CAPITAL) = 1, True, False)
Cells(2, 1) = CapsLock_On
Do
WaitMessage
If PeekMessage(msgMessage, lXLhwnd, WM_KEYDOWN, WM_KEYDOWN, PM_REMOVE) Then
iKeyCode = msgMessage.wParam
Run KeyPress(iKeyCode, KB_Array, aString, CapsLock_On, ShiftKey_On, aExit)
End If
Loop Until aExit = True
Cells(1, 1) = ""
End Sub
Private Function KeyPress(ByVal KeyAscii As Integer, ByRef KB_Array As KeyboardBytes, _
ByRef String1 As String, ByRef CapsLock_On As Boolean, _
ByRef ShiftKey_On As Boolean, ByRef aExit As Boolean)
Dim aValue As Long
Select Case KeyAscii
Case VK_BACK: If String1 <> "" Then String1 = Left(String1, Len(String1) - 1)
Case VK_SHIFT:
Case VK_CAPITAL:
KB_Array.kbByte(VK_CAPITAL) = IIf(KB_Array.kbByte(VK_CAPITAL) = 1, 0, 1)
SetKeyboardState KB_Array
CapsLock_On = IIf(KB_Array.kbByte(VK_CAPITAL) = 1, True, False)
Case VK_ESC: aExit = True
Case VK_SPACE: String1 = String1 & " "
Case 65 To 90: 'A to Z
If CapsLock_On = False Then aValue = KeyAscii + 32 Else aValue = KeyAscii
If GetAsyncKeyState(VK_SHIFT) And KEY_MASK < 0 Then ShiftKey_On = True Else ShiftKey_On = False
If ShiftKey_On = True Then
If CapsLock_On = True Then aValue = aValue + 32 Else aValue = aValue - 32
End If
String1 = String1 & Chr(aValue)
Case Else: String1 = String1 & "[" & Chr(KeyAscii) & " - " & KeyAscii & "]"
End Select
Cells(1, 1) = String1
End Function