VBA To Send Warning When The User Hasnt Worked In The Workbook For X Minutes

[accell]

I have seen the threads for closing the file when it is inactive but I just need it to send a notification when the workbook (that holds the code) is the 'Active' or showing workbook and has been active for X amount of minutes. When I tried to replace the 'Close' Sub with a notification sub in the above mentioned code it lived on into other workbooks when i closed the source workbook. Thanks!

[p45cal]

When I tried to replace the 'Close' Sub with a notification sub in the above mentioned code it lived on into other workbooks when i closed the source workbook.

Could you provide a link to the code(s) please - we'll tweak.

[accell]

This Code in a module.

Dim DownTime As Date

Sub SetTimer()
    DownTime = Now + TimeValue("01:00:00")
    Application.OnTime EarliestTime:=DownTime, _
      Procedure:="ShutDown", Schedule:=True
End Sub
Sub StopTimer()
    On Error Resume Next
    Application.OnTime EarliestTime:=DownTime, _
      Procedure:="ShutDown", Schedule:=False
 End Sub
Sub ShutDown()
    Application.DisplayAlerts = False
    With ThisWorkbook
        .Saved = True
        .Close
    End With
End Sub

And this in ' This Workbook'. Just a reminder, it is important for my purposes that it only sends a notification if the workbook is currently the active workbook.

Private Sub Workbook_Open()    Call SetTimer
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call StopTimer
End Sub
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
    Call StopTimer
    Call SetTimer
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, _
  ByVal Target As Excel.Range)
    Call StopTimer
    Call SetTimer

Thanks

[SamT]

I like your code. It is simple and elegant.

When I tried to replace the 'Close' Sub with a notification sub in the above mentioned code it lived on into other workbooks when i closed the source workbook.

Can you show us the Notification sub?

What exactly do you mean by "It lived on?" All running code in any Workbook is be terminated when the Workbook is closed.

[accell]

I Replaced:

Sub ShutDown() 
    Application.DisplayAlerts = False 
    With ThisWorkbook 
        .Saved = True 
        .Close 
    End With 
End Sub

With:

Sub Notification() 
    With ThisWorkbook 
        MsgBox "Still Recording Time"
    End With 
End Sub

(I also changed the original code to referene 'Notification' Sub instead of 'Shutdown')

When I closed the source workbook it would be automatically reopen itseld and send this notification when I was working in another workbook.

[SamT]

This is the workbook close program flow. Note the I commented out the lines in the bottom sub.

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call StopTimer
End Sub

Sub StopTimer()
    On Error Resume Next
    Application.OnTime EarliestTime:=DownTime, _
    Procedure:="Notification", Schedule:=False
End Sub

Sub Notification()
    'With ThisWorkbook
        MsgBox "Still Recording Time"
    'End With
End Sub

I haven't used OnTime enough to really know its ins and outs. It is an Application method, so its RAM is assigned to Excel, rather than any Workbook. This might be an issue if you have any other OnTime subs in any other workbook.

Change the MsgBox Line to MsgBox "Still Recording Time" & Me.Name and see what happens

[p45cal]

Some ideas to throw around. In a module:

Dim DownTime As Date
Public NotificationPending As Boolean
Sub SetTimer()
DownTime = Now + TimeValue("00:00:20")
Application.OnTime EarliestTime:=DownTime, Procedure:="ShutDown", Schedule:=True
NotificationPending = False
End Sub
Sub StopTimer()
On Error Resume Next
Application.OnTime EarliestTime:=DownTime, Procedure:="ShutDown", Schedule:=False
NotificationPending = False  'this line might not really be necessary.
End Sub
Sub ShutDown()
If ThisWorkbook Is ActiveWorkbook Then
  MsgBox "Notification"
  SetTimer
Else
  NotificationPending = True
End If
End Sub

In the Thisworkbook code module:

Private Sub Workbook_Open()
Call SetTimer
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call StopTimer
End Sub
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
Call StopTimer
Call SetTimer
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Excel.Range)
Call StopTimer
Call SetTimer
End Sub
Private Sub Workbook_Activate()
If NotificationPending Then
  MsgBox "Notification on workbook_activate via NotificationPending variable"
  NotificationPending = False
  SetTimer
End If
End Sub

Not thoroughly tested.

[accell]

I am getting the same issues. I think that the issue may be what SamT mentioned, that the Application.OnTime functioned cant be assigned to an individual workbook. Regardless of every variation I have tried the source workbook has been automatically reopened after closing and the set notification appears. The only way to close it is to delete the code or close Excel all together.

[p45cal]

I can only sort-of reproduce this re-opening of the workbook if I comment out the only line in:

Private Sub Workbook_BeforeClose(Cancel As Boolean) 
    Call StopTimer 
End Sub

[Kenneth Hobs]

Module:

Public DownTime As Date

Sub SetTimer()
    DownTime = Now + TimeValue("00:01:00")
    Application.OnTime EarliestTime:=DownTime, _
    Procedure:="ShutDown", Schedule:=True
End Sub

Sub StopTimer()
    On Error Resume Next
    Application.OnTime EarliestTime:=DownTime, _
    Procedure:="ShutDown", Schedule:=False
End Sub

Sub ShutDown()
    With ThisWorkbook
        .Saved = True
        .Close
    End With
End Sub

Thisworkbook:

Private Sub Workbook_Activate()
  StopTimer
  SetTimer
End Sub

Private Sub Workbook_Deactivate()
  StopTimer
End Sub

Private Sub Workbook_Open()
  'SetTimer
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
  StopTimer
End Sub

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
  StopTimer
  SetTimer
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, _
  ByVal Target As Excel.Range)
  StopTimer
  SetTimer
End Sub

[SamT]

Ken,

Are you thinking that Activate and Open are setting two different OnTime TSA routines with millisecond time differences?

Enquiring minds want to know.

[Kenneth Hobs]

It does not hurt to set the Open timer but Activate needs to be set for switching between workbooks anyway. So, I just found it a bit overkill to set it twice on open. The two events fire so fast, it does not matter that much though...

[SamT]

@ Ken,

@ OP, Store all the OnTime Code in a module in your Personal.xls book. I think that will solve your issue and allow you to use the same ThisWorkbook Code in many workbooks at the same time.

Personal.xls Module "Reminder" Code


See second post below

ThisWorkBook Module

Private Sub Workbook_Activate()
    StopTimer
    SetTimer Me.Name
End Sub
 
Private Sub Workbook_Deactivate()
    StopTimer
End Sub
 
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
    StopTimer
    SetTimer Me.Name
End Sub
 
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, _
    ByVal Target As Excel.Range)
    StopTimer
    SetTimer Me.Name
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    StopTimer
End Sub

Tip: if you pass the wait time as a string to SetTimer and StopTimer, you can use different notification wait times in each book.

 WaitTime = 01:00:00"
SetTimer Me.Name WaitTime

Public Sub SetTimer(BookName As String, WaitTime As String)
    CurrBook = BookName
    DownTime = Now + TimeValue(WaitTime)

[snb]

2 things to remind:

- if you start an 'ontime' procedure in which you specify the 'next time' it has to be fired
- you will have to stop that 'ontime' procedure using the exact 'next time' it had to be fired off.

As long as you haven't stopped the 'ontime' procedure correctly, Excel will be triggering it again, even if the file has been closed. It will be opened by Excel automatically.

So basically you need a place to store the 'next time' somewhere to be able to stop the 'on time' procedure.
That place can be a variable, or any place the application has access to.

E.g. to start the procedure M_snb every 10 seconds:

Sub M_snb()
    Application.StatusBar = DateAdd("s", 10, Now)
    Application.OnTime CDate(Application.StatusBar), "M_snb"
End Sub

Sub M_snb_stop()
    Application.OnTime CDate(Application.StatusBar), "M_snb", , False
End Sub

[SamT]

Save the values!

Personal.xls Module code

Private Function GetDownTime(Optional DownTime As Date) As Date
Static fDowntime As Date
  If DownTime = 0 Then
    GetDownTime = fDowntime
  Else
   fDowntime = DownTime
  End If
End Function

Private Function GetCurrBook(Optional CurrBook As String) As String
Static fCurrBook As String
  If CurrBook = "" Then
    GetCurrBook = fCurrBook
  Else
    fCurrBook = CurrBook
  End If
End Function

Public Sub SetTimer(BookName As String)
    GetCurrBook BookName
    GetDownTime Now + TimeValue("01:00:00")
    Application.OnTime EarliestTime:=GetDownTime, _
    Procedure:="ShutDown", Schedule:=True
End Sub

Public Sub StopTimer()
    On Error Resume Next
    Application.OnTime EarliestTime:=GetDownTime, _
    Procedure:="ShutDown", Schedule:=False
End Sub

Sub Notification()
     On Error Resume Next
     If Workbooks(GetCurrBook) Is Nothing Then Exit Sub
    MsgBox "Still Recording Time"
End Sub

[accell]

Hey Guys, I added the tweaks from Kenneths code and I think it fixed the bug. There are some extra procedures in the module code that are from a logsheet SamT helped create. Anyway I think its working so don't want to change it but if it breaks i'll try some of the other suggestions. Thanks Guys! My boss thinks Im super smart (=

In a module.

Const LogSheet As String = "Log"Const BaseCol As String = "B"
Public DownTime As Date
 
Sub SetTimer()
    DownTime = Now + TimeValue("00:10:05")
    Application.OnTime EarliestTime:=DownTime, _
    Procedure:="Notify", Schedule:=True
End Sub
 
Sub StopTimer()
    On Error Resume Next
    Application.OnTime EarliestTime:=DownTime, _
    Procedure:="Notify", Schedule:=False
End Sub
 
Sub Notify()
    With ThisWorkbook
      If Len(ThisWorkbook.Sheets("Log").Range("B2")) > 0 Then
        MsgBox "Deactivated"
        Sheets(LogSheet).Cells(Rows.Count, BaseCol).End(xlUp).Offset(0, 1).Value = Now
        Application.StatusBar = "Off The Clock"
      End If
      MSG1 = MsgBox("You Are Still Recording Time Recording Time For " & ThisWorkbook.Name, vbOKOnly)
      If MSG1 = vbOK Then
        MsgBox "Activated"
        Sheets(LogSheet).Cells(Rows.Count, BaseCol).End(xlUp).Offset(1, 0).Value = Now
        Application.StatusBar = "On The Clock"
      End If
    End With
End Sub

In 'ThisWorkbook'

 
Private Sub Workbook_WindowActivate(ByVal Wn As Excel.Window)
    StopTimer
    SetTimer
End Sub
 
Private Sub Workbook_WindowDeactivate(ByVal Wn As Excel.Window)
    StopTimer
End Sub
 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    StopTimer
End Sub
 
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
    StopTimer
    SetTimer
End Sub
 
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, _
    StopTimer
    SetTimer
End Sub

[accell]

Unfortunately I am back. The code works well until two files are built from the template and are running at the same time.

- To SamT: Unfortunately, I can't use the personal workbook as a location for code because I need to send this template to many who are unfamiliar/unable to update their own Personal.xls.
- To snb: I think I understand the concept of cancelling out the ontime function but was wondering if you could help clarify how that translates to cancelling this sub:

Sub SetTimer() 
    DownTime = Now + TimeValue("00:10:00") 
    Application.OnTime EarliestTime:=DownTime, _ 
    Procedure:="Notify", Schedule:=True 
End Sub

So that the ontime function is only calculating if the workbook is active?

[accell]

Also, when I open a downloaded Excel file in protected view (and consequently deactivate the current workbook) it looks like the code that is supposed to run under the Workbook_Deactivate Sub is referencing the newly opened workbook instead of making the changes before deactivating and is causing the following errors. Any ideas on how to prevent this?

Method 'statusBar of object ' _Application ' failed
Method 'OnTime' of object' _Application' failed
Object variable or With block variable not set

[SamT]

In any ThisWorkbook code page "Me.Name" will return the name of the ThisWorkbook.

You may have to pass the Results of Me.Name to the stop and start timer subs, and test it against the ActiveWindow.Parent.Name , then pass the results of Me.Name to the notify sub.

First, try moving the variable "DownTime' to the ThisWorkbook module and retrieve it with a "Friend" function". I think the ThisWorkbook module is a Class module.

Friend Function DownTime(Optional newDownTime As Date) As Date
    Static fDowntime As Date
    If NewDownTime = 0 Then
       DownTime = fDowntime
    Else
        fDowntime = NewDownTime
    End If
End Function

Friend Function CurrBook(Optional NewCurrBook As String) As String
    Static fCurrBook As String
    If NewCurrBook = "" Then
        CurrBook = fCurrBook
    Else
        fCurrBook = NewCurrBook
    End If
End Function

[snb]

That's exactly why I prefer to store the 'next time' in an Application.object/property: the statusbar.
Variables have only a limited scope (the workbook).