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)）上，上面写着“编译错误：未定义用户定义的类型”。我已经启用了Microsoft 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

使用VBA检测不活动

1 个答案: