VBA中使用Waitable Timer对象遭遇无效句柄错误求助

I've run into this exact issue before when working with Waitable Timers in VBA, especially when dealing with 64-bit Excel environments. Let's break down why you're getting Error 6 (invalid handle) and how to fix it:

Root Cause #

The primary issue here is 64-bit compatibility in your API declarations and variable types. When you declare timerHandle As Long, on 64-bit systems this truncates the 64-bit handle returned by CreateWaitableTimer to 32 bits, making it invalid for subsequent calls to SetWaitableTimer. Additionally, your API declarations lack the PtrSafe keyword, which is mandatory for 64-bit VBA.

Corrected API Declarations & Types #

First, update your declarations to support both 32-bit and 64-bit VBA using conditional compilation:

#If VBA7 Then
    Public Declare PtrSafe Function CreateWaitableTimer Lib "kernel32" Alias "CreateWaitableTimerA" ( _
        ByVal lpTimerAttributes As LongPtr, _
        ByVal manualReset As Boolean, _
        ByVal lpTimerName As LongPtr) As LongPtr
    
    Public Declare PtrSafe Function SetWaitableTimer Lib "kernel32" ( _
        ByVal timerHandle As LongPtr, _
        lpDueTime As FILETIME, _
        ByVal lPeriod As Long, _
        ByVal pfnCompletionRoutine As LongPtr, _
        ByVal lpArgToCompletionRoutine As LongPtr, _
        ByVal fResume As Boolean) As Boolean
    
    Public Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
    End Type
#Else
    Public Declare Function CreateWaitableTimer Lib "kernel32" Alias "CreateWaitableTimerA" ( _
        ByVal lpTimerAttributes As Long, _
        ByVal manualReset As Boolean, _
        ByVal lpTimerName As Long) As Long
    
    Public Declare Function SetWaitableTimer Lib "kernel32" ( _
        ByVal timerHandle As Long, _
        lpDueTime As FILETIME, _
        ByVal lPeriod As Long, _
        ByVal pfnCompletionRoutine As Long, _
        ByVal lpArgToCompletionRoutine As Long, _
        ByVal fResume As Boolean) As Boolean
    
    Public Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
    End Type
#End If

Key changes:

• Added PtrSafe keyword for VBA7 (64-bit) compatibility
• Replaced Long with LongPtr for handle/pointer parameters to support 64-bit addresses
• Used conditional blocks to maintain compatibility with older 32-bit VBA versions

Corrected Calling Code #

Update your variable types and call logic to match the corrected declarations:

Public args As Long ' Keep as Long if passing a value, use LongPtr if passing a pointer

Sub TestWaitableTimer()
    Dim timerHandle As LongPtr
    Dim absoluteDueTime As FILETIME
    Dim currentTime As Currency
    
    ' Set due time to current time + 1 second (adjust for sub-second delays as needed)
    currentTime = Now
    currentTime = currentTime + TimeSerial(0, 0, 1)
    ConvertVbaTimeToFileTime currentTime, absoluteDueTime
    
    timerHandle = CreateWaitableTimer(0, False, 0)
    If timerHandle = 0 Then
        Debug.Print "CreateWaitableTimer Error: " & GetSystemErrorMessageText(Err.LastDllError)
        Exit Sub
    End If
    Debug.Print "CreateWaitableTimer Success: " & GetSystemErrorMessageText(Err.LastDllError)
    
    If Not SetWaitableTimer(timerHandle, absoluteDueTime, 0, AddressOf TimerCallbacks.pointerProc, VarPtr(args), False) Then
        Debug.Print "SetWaitableTimer Error: " & GetSystemErrorMessageText(Err.LastDllError)
    Else
        Debug.Print "SetWaitableTimer Success"
    End If
End Sub

' Helper to convert VBA time to FILETIME format
Sub ConvertVbaTimeToFileTime(vbaTime As Currency, ft As FILETIME)
    ' VBA time is days since 1/1/1900; FILETIME is 100-nanosecond intervals since 1/1/1601
    Dim ftValue As Currency
    ftValue = (vbaTime + 25569) * 864000000000@ ' Convert to 100ns intervals
    ft.dwLowDateTime = CLng(ftValue)
    ft.dwHighDateTime = CLng(ftValue \ 2 ^ 32)
End Sub

Update your callback procedure to support 64-bit pointers (and add a helper to read the passed parameter):

Public Sub pointerProc(ByVal argPtr As LongPtr, ByVal timerLowValue As Long, ByVal timerHighValue As Long)
    Dim paramValue As Long
    CopyMemory paramValue, ByVal argPtr, Len(paramValue)
    Debug.Print "pointerProc called at " & Time & " | Parameter: " & paramValue
End Sub

' Add CopyMemory declaration to access the passed parameter
#If VBA7 Then
    Public Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
        ByRef Destination As Any, _
        ByRef Source As Any, _
        ByVal Length As LongPtr)
#Else
    Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
        ByRef Destination As Any, _
        ByRef Source As Any, _
        ByVal Length As Long)
#End If

Additional Tips #

• Sub-second delays: To set delays shorter than 1 second, adjust the time calculation (e.g., add 0.000011574 to currentTime for a 1-millisecond delay, since 1ms = 1/86400/1000 days)
• Thread safety: Waitable Timer callbacks run in a separate thread, so avoid direct interactions with Excel objects (worksheets, cells) in the callback. Use Application.OnTime from the callback if you need to update the UI.
• Resource cleanup: Always close the timer handle when done to avoid leaks:

  #If VBA7 Then
      Public Declare PtrSafe Function CloseHandle Lib "kernel32" (ByVal hObject As LongPtr) As Boolean
  #Else
      Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Boolean
  #End If
  

内容的提问来源于stack exchange，提问作者Greedo