Solved: Possible for excel to detect inactivity at pc?

[fourstar787]

The other day at work a user left his machine over lunch and left our main workbook open! The result - i couldn't open the file (other than read only) which was of no use to me!

I was wondering if it is possible for excel to detect a period of inactivity (or get the system inactivity info) and automatically save and close. To prevent this happening in the future!

Any ideas would be much appreciated.

[Simon Lloyd]

What you can do is this, add this to the Thisworkbook code module[vba]Option Explicit
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
ResetTimer
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
ResetTimer
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
ResetTimer
End Sub[/vba]and add this to a standard code module[vba]Public CloseDownTime As Variant
Public Sub ResetTimer()
On Error Resume Next
If Not IsEmpty(CloseDownTime) Then Application.OnTime EarliestTime:=CloseDownTime, Procedure:="CloseDownFile", Schedule:=False
CloseDownTime = Now + TimeValue("00:00:30") ' change as needed
Application.OnTime CloseDownTime, "CloseDownFile"
End Sub

Public Sub CloseDownFile()
On Error Resume Next
Application.StatusBar = "Inactive File Closed: " & ThisWorkbook.Name
ThisWorkbook.Close SaveChanges:=True
End Sub[/vba]Now the file will close if there hasn't been any activity for 30 seconds

[fourstar787]

Many many thanks for your reply!
I'll drop this code into a workbook in a shortwhile and play with it a little before adding to my main workbook at work
thanks again!

[fourstar787]

all tests are working great!
thank again!

[Jan Karel Pieterse]

The code offered will also close the file if Excel is left unattended, but the user IS working, e.g. in Outlook. You can use this code to detect system inactivity (KB and mouse). The function returns the idle time in seconds:

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

[fourstar787]

Thats probably more appropriate to be honest! Many thanks!
I will just have to figure out how/when to call the function to make best use of it!

I will test it out when i get to work!

Thanks again

[Jan Karel Pieterse]

Modify this routine:

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

[Aussiebear]

Have you people no shame!!!! You have got to admit it sometimes happens that you are deep and meaningful into a workbook and you get distracted..... a text message from your buddy about going to the game friday night, or a phone call from your girlfiend... I mean your missus, about the leaking tap, or the video you are not supposed to be downloading at work, well you know your attention is away somewhereelse for just a moment or two.

So why not a simple message to the user to warn them of the impending closure? Something that rates highly in the politically correct office ettique like.... "heh dopey, park this baby back in the garage, or I'm going to have two of my friends come round there and break both of your knees".

[fourstar787]

Have you people no shame!!!! You have got to admit it sometimes happens that you are deep and meaningful into a workbook and you get distracted..... a text message from your buddy about going to the game friday night, or a phone call from your girlfiend... I mean your missus, about the leaking tap, or the video you are not supposed to be downloading at work, well you know your attention is away somewhereelse for just a moment or two.

So why not a simple message to the user to warn them of the impending closure? Something that rates highly in the politically correct office ettique like.... "heh dopey, park this baby back in the garage, or I'm going to have two of my friends come round there and break both of your knees".

Ha ha! I like it!

I was going to add such a warning - it was just the mechanics of detecting inactivity that i was struggling with!

[Kenneth Hobs]

In your warning, you might give them one more chance. e.g.
[VBA]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.


[/VBA]