用VBA检测无活动状态

Question

我正在尝试写一个脚本，如果有计算机(不仅仅是excel)在这么长时间后没有活动，它将自动保存和关闭excel文件。向用户发出警告的消息框也是我想要包含的一个很好的特性。我发现了一些看起来完全符合我的需求的代码(http://www.vbaexpress.com/forum/showthread.php?33711-Solved-Possible-for-excel-to-detect-inactivity-at-pc)，但我似乎无法让它正常工作。我把这段代码放在一个模块中，但是它挂在第一行(Private Declare Sub GetLastInputInfo Lib "USER32" (ByRef plii As LASTINPUTINFO))上，上面写着“编译错误:用户定义的类型未定义”。我已经启用了微软ActiveX数据对象6.1库，但仍然得到了相同的结果。我对VBA相当陌生，所以我不能很好地阅读别人的代码，所以如果我遗漏了一些简单的东西，那么很抱歉。

Private Declare Sub GetLastInputInfo Lib "USER32" (ByRef plii As LASTINPUTINFO)

Function IdleTime() As Single
  Dim a As LASTINPUTINFO
  a.cbSize = LenB(a)
  GetLastInputInfo a
  IdleTime = (GetTickCount - a.dwTime) / 1000
End Function

Public Sub CloseDownFile()
On Error Resume Next
If IdleTime > 30 Then
Application.StatusBar = "Inactive File Closed: " & ThisWorkbook.Name
ThisWorkbook.Close SaveChanges:=True
Else
CloseDownTime = Now + TimeValue("00:00:30") ' change as needed
Application.OnTime CloseDownTime, "CloseDownFile"
End If
End Sub

Sub Test_MsgBoxWait()
Dim rc As Long
rc = MsgBoxWait("UserName", "Is your computer user name " & _
Environ("username") & "?" & vbLf & _
"I will wait 5 seconds for your response.", 1, 2) '4+32
Select Case rc
Case 6
MsgBox "Congratulations, you are correct."
Case 7
MsgBox "I am sorry, that is incorrect." & vbLf & _
"Your computer username is " & Environ("username") & "."
Case Else
MsgBox "The return code was: " & rc
End Select
End Sub

'Function MsgBoxWait(strTitle As String, strText As String, _
nType As Integer, nSecondsToWait As Integer)
Function MsgBoxWait(strTitle As String, strText As String, _
nType As Long, nSecondsToWait As Integer)
Dim ws As Object, rc As Long
Set ws = CreateObject("WScript.Shell")
rc = ws.Popup(strText, nSecondsToWait, strTitle, nType)
Set ws = Nothing
MsgBoxWait = rc
End Function

'Arguments
'Object
'WshShell object.
'strText
'String value containing the text you want to appear in the pop-up message box.
'nSecondsToWait
'Numeric value indicating the maximum length of time (in seconds) you want the pop-up message box displayed.
'strTitle
'String value containing the text you want to appear as the title of the pop-up message box.
'nType
'Numeric value indicating the type of buttons and icons you want in the pop-up message box. These determine how the message box is used.
'IntButton //not used but returned as result of MsgBoxWait().
'Integer value indicating the number of the button the user clicked to dismiss the message box. This is the value returned by the Popup method.
'Remarks
'The Popup method displays a message box regardless of which host executable file is running (WScript.exe or CScript.exe). If
' nSecondsToWaitis equals zero (the default), the pop-up message box remains visible until closed by the user. If
' nSecondsToWaitis is greater than zero, the pop-up message box closes after nSecondsToWait seconds. If you do not supply
' the argument strTitle, the title of the pop-up message box defaults to "Windows Script Host." The meaning of nType is the
' same as in the Microsoft Win32® application programming interface MessageBox function. The following tables show the
' values and their meanings. You can combine values in these tables.
'
'Note To display text properly in RTL languages such as Hebrew or Arabic, add hex &h00100000 (decimal 1048576) to the nType parameter.
'Button Types
'
'Value Description
'0 Show OK button.
'1 Show OK and Cancel buttons.
'2 Show Abort, Retry, and Ignore buttons.
'3 Show Yes, No, and Cancel buttons.
'4 Show Yes and No buttons.
'5 Show Retry and Cancel buttons.
'
'Icon Types
'
'Value Description
'16 Show "Stop Mark" icon.
'32 Show "Question Mark" icon.
'48 Show "Exclamation Mark" icon.
'64 Show "Information Mark" icon.
'
'The previous two tables do not cover all values for nType. For a complete list, see the Microsoft Win32 documentation.
'
'The return value intButton denotes the number of the button that the user clicked. If the user does not click a button before nSecondsToWait seconds, intButton is set to -1.
'
'Value Description
'1 OK Button
'2 Cancel Button
'3 Abort Button
'4 Retry Button
'5 Ignore Button
'6 Yes Button
'7 No Button
'
' Note: intButton is not used here. The value for intButton is returned to from the Function.

Answer 1

只需声明LASTINPUTINFO类型：

Private Type LASTINPUTINFO
  cbSize As Long
  dwTime As Long
End Type

Private Declare Sub GetLastInputInfo Lib "user32" (ByRef plii As LASTINPUTINFO)

Private Declare Function GetTickCount Lib "kernel32" () As Long

Function IdleTime() As Single
  Dim a As LASTINPUTINFO
  a.cbSize = LenB(a)
  GetLastInputInfo a
  IdleTime = (GetTickCount - a.dwTime) / 1000
End Function