UserPressed(): Break Out of a Long-Running Loop in VBA with the Escape Key

Long-time reader and friend of the blog, Ben Sacherich, wrote in with an API call that I had never used before: GetAsyncKeyState.

According to the docs, this function:

Determines whether a key is up or down at the time the function is called, and whether the key was pressed after a previous call to GetAsyncKeyState.

As it is an API call, we need to declare it using the Declare keyword like so:

Private Declare PtrSafe Function GetAsyncKeyState Lib "user32" _
    (ByVal vKey As Long) As Integer

Breaking Out of a Loop

One way to use this function, as Ben himself suggested, is to give your users a way to break out of a long-running loop:

Do
    If LongRunningProcessIsFinished() Then Exit Do
    
    If GetAsyncKeyState(vbKeyEscape) Then
        DoEvents  'This is required or the MsgBox won't show
        MsgBox "User canceled with Escape", vbInformation
        Exit Do  'or Exit For, etc.
    End If
Loop

Working Example

Here's a fully working example you can drop into VBA and test yourself.  I use the SysCmd status bar actions to update a progress meter for something interesting to look at while the loop progresses:

Private Declare PtrSafe Sub Sleep Lib "kernel32" _
    (ByVal dwMilliseconds As Long)

Private Declare PtrSafe Function GetAsyncKeyState Lib "user32" _
    (ByVal vKey As Long) As Integer


Sub TestLoopEscape()
    Dim i As Long
    For i = 0 To 100
        
        'Set the status bar text, max value, and current value
        SysCmd acSysCmdInitMeter, i & " of 100", 100
        SysCmd acSysCmdUpdateMeter, i
        
        'Pause for half a second
        Sleep 500
        
        'Check to see if user pressed Escape
        '   NOTE: this returns True even if the Access window
        '         does not have the focus (e.g., if the user
        '         presses [Escape] while using Notepad)
        If GetAsyncKeyState(vbKeyEscape) Then
            DoEvents  'This is required or the MsgBox won't show
            MsgBox "User canceled with Escape", vbInformation
            Exit For
        End If
    Next i
    
    'Clear the status bar
    SysCmd acSysCmdSetStatus, " "
End Sub

Convenience Function

I like to wrap APIs in my own procedures, rather than call them directly.  

Here's a very simple convenience function.  I'm calling it "UserPressed" because it makes for more readable code when combined with an If statement, which is how it most often will be used:

' ----------------------------------------------------------------
' Procedure : UserPressed
' Date      : 11/2/2023
' Author    : Mike Wolfe
' Source    : https://nolongerset.com/userpressed/
' Purpose   : Simple wrapper for the GetAsyncKeyState API function.
' Notes     - Returns True:
'               o if the user is pressing the button
'                 at the time of the function call OR
'               o if the user pressed the button at any time
'                 since the last call to the function
'           - This detects key presses in ANY Windows application,
'               not just the host application
'           - You do not need to call DoEvents for this to work
'               (not even in a tight loop)
'           - Use one of the VBA.KeyCodeConstants to pass in a 
'               KeyCode to make your code more readable
'           - The form KeyPreview property is unrelated to this API
'               (it does not need to be set any specific way)
' ----------------------------------------------------------------
Public Function UserPressed(KeyCode As Long) As Boolean
    Dim Result As Integer
    Result = GetAsyncKeyState(KeyCode)
    'Debug.Print Result   'Uncomment for debugging
    
    UserPressed = CBool(Result)
End Function

Convenience Function Sample Usage

Here's a different sample method that uses the UserPressed convenience function and proves that DoEvents and Sleep are not necessary preconditions for the GetAsyncKeyState() function to work.

Sub TestLoopEscapeWithoutSleepOrDoEvents()
    'Initialize a loop counter
    Dim i As Long
    i = 0
    
    Do Until i > 100
        i = i + 1
                
        'Set the status bar text, max value, and current value
        SysCmd acSysCmdInitMeter, i & " of 100", 100
        SysCmd acSysCmdUpdateMeter, i
        
        'Insert an artificial pause without Sleep or DoEvents to
        '   demonstrate that GetAsyncKeyState works even without
        '   those methods there to yield processing time
        Dim j As Long: j = 0
        Do While j < 200000000
            j = j + 1
        Loop
        
        'Substitute the convenience function for the direct API call
        If UserPressed(vbKeyEscape) Then
            DoEvents  'This is still required or the MsgBox won't show
            MsgBox "User canceled with Escape", vbInformation
            Exit Do
        End If
    Loop
    
    'Clear the status bar
    SysCmd acSysCmdSetStatus, " "
End Sub

Caveats

There are some important things to be aware of when using this API call:

• Key presses in ANY application get picked up (not just in your Access app): this means that if your user switches to their web browser while waiting for your long process to complete, they could inadvertently kill that long-running process without even realizing it!
• According to the docs, the behavior we're relying on is unreliable: "Although the least significant bit of the return value indicates whether the key has been pressed since the last query, due to the preemptive multitasking nature of Windows, another application can call GetAsyncKeyState and receive the 'recently pressed' bit instead of your application. The behavior of the least significant bit of the return value is retained strictly for compatibility with 16-bit Windows applications (which are non-preemptive) and should not be relied upon."

Personally, I use a custom cancelable Progress Meter form to allow my users to exit prematurely from certain types of long-running loops.  I use a [Cancel] command button on the form, which avoids both of the pitfalls detailed above.

In other words, I don't plan on changing my UX for long-running cancelable processes.  

That said, I found this API call to be an interesting option and, in practice, it may work just fine.  If you do use it in your code, be sure to report back with your results to help guide future readers.

Special thanks to Ben Sacherich for submitting today's tip.

Cover image created with Microsoft Designer and StableDiffusionXL