VBA中GetLastInputInfo与GetTickCount的PtrSafe声明错误排查：64位环境编译失败问题

看起来你在把32位VBA的系统空闲检测代码适配64位环境时遇到了编译错误，核心问题出在LASTINPUTINFO结构的定义和API函数的类型匹配上。我来一步步拆解问题并给出修正方案：

关键问题分析 #

1. LASTINPUTINFO结构的cbSize字段错误
   Windows API中，LASTINPUTINFO的cbSize是DWORD类型（32位无符号整数），无论在32位还是64位系统下，它的大小都是4字节。你在64位分支里把它定义为LongPtr（64位），这会导致结构大小不匹配，不仅可能触发编译警告，还会让GetLastInputInfo调用失败。

2. GetTickCount的溢出风险与类型匹配
   原生的GetTickCount返回32位的DWORD，在系统运行超过49.7天后会溢出。在64位环境下，更推荐使用GetTickCount64（返回64位的ULONGLONG），对应VBA中的LongLong或LongPtr（64位VBA中LongPtr等价于LongLong）。

修正后的完整代码 #

#If VBA7 Then ' Office 2013及以上版本支持VBA7
    #If Win64 Then ' 64位Office环境
        Private Declare PtrSafe Function GetTickCount64 Lib "kernel32" () As LongLong
        Private Declare PtrSafe Sub GetLastInputInfo Lib "User32" (ByRef plii As LASTINPUTINFO)
        Private Type LASTINPUTINFO
            cbSize As Long ' DWORD是32位，始终用Long
            dwTime As LongLong ' dwTime是DWORD_PTR，64位下用LongLong
        End Type
    #Else ' 32位Office环境
        Private Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long
        Private Declare PtrSafe Sub GetLastInputInfo Lib "User32" (ByRef plii As LASTINPUTINFO)
        Private Type LASTINPUTINFO
            cbSize As Long
            dwTime As Long ' 32位下DWORD_PTR是Long
        End Type
    #End If
#Else ' Office 2010及以下版本（仅32位）
    Private Declare Sub GetLastInputInfo Lib "User32" (ByRef plii As LASTINPUTINFO)
    Private Declare Function GetTickCount Lib "kernel32" () As Long
    Private Type LASTINPUTINFO
        cbSize As Long
        dwTime As Long
    End Type
#End If

Function IdleTime() As Single
    Dim a As LASTINPUTINFO
    a.cbSize = LenB(a) ' 自动获取结构的字节大小，避免手动硬编码出错
    GetLastInputInfo a
    
    #If VBA7 And Win64 Then
        IdleTime = (GetTickCount64 - a.dwTime) / 1000
    #Else
        IdleTime = (GetTickCount - a.dwTime) / 1000
    #End If
End Function

Sub Form_Timer()
    Dim LR As Long, tme As Single
    LR = ThisWorkbook.Sheets("Inaktivitet").Cells(Sheets("Inaktivitet").Rows.Count, "B").End(xlUp).Row
    
    ' 检查当前用户是否在排除列表中
    If Not IsError(Application.Match(UCase(Environ("UserName")), ThisWorkbook.Sheets("Inaktivitet").Range("B21:B" & LR), 0)) Then
        ' 重新设置定时器，避免退出后停止
        Application.OnTime Now + TimeSerial(0, 0, 5), "Form_Timer"
        Exit Sub
    End If
    
    tme = IdleTime
    Debug.Print tme & " " & Now()
    
    ' 超过阈值则保存并关闭
    If tme >= ThisWorkbook.Sheets("Inaktivitet").Range("E14").Value * 60 Then
        ThisWorkbook.Save
        Application.EnableEvents = False
        ThisWorkbook.Close
        Application.EnableEvents = True
    Else
        Application.OnTime Now + TimeSerial(0, 0, 5), "Form_Timer"
    End If
End Sub

额外优化说明 #

• 我把Form_Timer里的变量都显式声明了（Dim LR As Long, tme As Single），这是VBA的最佳实践，避免隐式类型带来的问题。
• 在IdleTime函数里针对64位环境单独处理GetTickCount64的调用，彻底避免溢出风险。
• 调整了Form_Timer的定时器逻辑：即使用户在排除列表中，也会重新设置定时器，确保后续检测能持续执行。

无64位环境的验证建议 #

虽然你没有64位电脑，但可以通过以下方式尽量确保代码正确性：

• 确保所有VBA7分支的Declare都添加了PtrSafe关键字（你之前已经做到了）。
• 核对Windows API文档中每个结构和函数的类型定义：LASTINPUTINFO的官方定义里，cbSize是DWORD，dwTime是DWORD_PTR（32位为32位，64位为64位），我们的类型匹配完全符合官方规范。

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