I found this helpful too, thanks. I would like to take this in a
slightly different direction and detect when a user is no longer idle.
I thought I had the answer by using the above, to wit:
Workbook_Open() contains:
Option Explicit
Option Base 1
Dim AppClass As New EventClass
Private Sub Workbook_Open()
Set AppClass.App = Application
End Sub
and I have a Class Module named "EventClass" with things like this in
it:
Option Explicit
Public WithEvents App As Application
Private Sub App_NewWorkbook(ByVal Wb As Excel.Workbook)
MsgBox "NewWorkbook: " & Wb.Name
bStopFetchingFlag = True 'If we're fetching, this stops us after
the current one
SetNewTimer
End Sub
Private Sub App_SheetActivate(ByVal Sh As Object)
MsgBox "Sheet Activated: " & Sh.Name
bStopFetchingFlag = True
SetNewTimer
End Sub
and then another module containing:
Sub SetNewTimer()
ResetTimer 'Cancel any existing timer before starting a new one
'adjust the time below to your needs, this is 30 minutes
dNextTime = Now + TimeValue("00:30:00")
Application.OnTime dNextTime, "DoThings"
End Sub
Sub ResetTimer()
Application.OnTime dNextTime, "DoThings", False
End Sub
Sub DoThings()
Dim i As Long
For i = 1 To 100000
DoEvents
If bStopFetchingFlag Then
MsgBox "We were stopped!"
End If
Next i
End Sub
The trouble is, once "DoThings" starts, the bStopFetchingFlag variable
never becomes true, even though I add sheets, activate sheets, change
sheets, etc. - all the events I trap for in EventClass.
Obviously, DoThings above is just a testing routine - the one I
actually want to use is much more complicated, but I want to stop it
(while remembering how far it got), in case the user comes back and
wants to do some other Excel work. My stuff would be packaged in an
add-in.
Many things for any help anyone can provide.
OK, I'll reply to my own post in the hope it will help others who find
this on a Google search or somesuch.
I suspect my problem was two-fold: First, I was not disabling events
once I got an event, so I may been having a recursion problem; and,
second, I had the syntax wrong on some of my Application events, so
they were never firing. Here's what I ended up doing for "DoThings":
Sub DoThings()
Dim i As Long
On Error GoTo ErrXIT
For i = 1 To 100000
DoEvents
If bStopFetchingFlag Then
Application.EnableEvents = False
MsgBox "We were stopped!"
bStopFetchingFlag = False
Exit For
End If
Next i
ErrXIT:
Application.EnableEvents = True
End Sub
And, finally, here's the whole list of Application events:
Option Explicit
Public WithEvents App As Application
Private Sub App_NewWorkbook(ByVal Wb As Excel.Workbook)
bStopFetchingFlag = True 'If we're fetching, this stops us after
the current one
SetNewTimer
End Sub
Private Sub App_SheetActivate(ByVal Sh As Object)
bStopFetchingFlag = True
SetNewTimer
End Sub
Private Sub App__SheetBeforeDoubleClick(ByVal Sh As Object, _
ByVal Target As Range, Cancel As Boolean)
bStopFetchingFlag = True
SetNewTimer
End Sub
Private Sub App_SheetBeforeRightClick(ByVal Sh As Object, _
ByVal Target As Range, Cancel As Boolean)
bStopFetchingFlag = True
SetNewTimer
End Sub
Private Sub App_SheetCalculate(ByVal Sh As Object)
bStopFetchingFlag = True
SetNewTimer
End Sub
Private Sub App_SheetChange(ByVal Sh As Object, _
ByVal Target As Range)
bStopFetchingFlag = True
SetNewTimer
End Sub
Private Sub App_SheetDeactivate(ByVal Sh As Object)
bStopFetchingFlag = True
SetNewTimer
End Sub
Private Sub App_SheetSelectionChange(ByVal Sh As Object, ByVal Target
As Excel.Range)
bStopFetchingFlag = True
SetNewTimer
End Sub
Private Sub App_WindowActivate(ByVal Wb As Excel.Workbook, ByVal Wn As
Excel.Window)
bStopFetchingFlag = True
SetNewTimer
End Sub
Private Sub App_WindowDeactivate(ByVal Wb As Excel.Workbook, ByVal Wn
As Excel.Window)
bStopFetchingFlag = True
SetNewTimer
End Sub
Private Sub App_WindowResize(ByVal Wb As Excel.Workbook, ByVal Wn As
Excel.Window)
bStopFetchingFlag = True
SetNewTimer
End Sub
Private Sub App_WorkbookActivate(ByVal Wb As Excel.Workbook)
bStopFetchingFlag = True
SetNewTimer
End Sub
Private Sub App_WorkbookAddInInstall(ByVal Wb As Workbook)
bStopFetchingFlag = True
SetNewTimer
End Sub
Private Sub App_WorkbookAddInUninstall(ByVal Wb As Workbook)
bStopFetchingFlag = True
SetNewTimer
End Sub
Private Sub App_WorkbookBeforeClose(ByVal Wb As Workbook, Cancel As
Boolean)
bStopFetchingFlag = True
SetNewTimer
End Sub
Private Sub App_WorkbookBeforePrint(ByVal Wb As Workbook, Cancel As
Boolean)
bStopFetchingFlag = True
SetNewTimer
End Sub
Private Sub App_WorkbookBeforeSave(ByVal Wb As Workbook, ByVal
SaveAsUi As Boolean, Cancel As Boolean)
bStopFetchingFlag = True
SetNewTimer
End Sub
Private Sub App_WorkbookDeactivate(ByVal Wb As Workbook)
bStopFetchingFlag = True
SetNewTimer
End Sub
Private Sub App_WorkbookNewSheet(ByVal Wb As Workbook, ByVal Sh As
Object)
bStopFetchingFlag = True
SetNewTimer
End Sub
Private Sub App_WorkbookOpen(ByVal Wb As Excel.Workbook)
bStopFetchingFlag = True
SetNewTimer
End Sub
