PDA

View Full Version : VBA To Send Warning When The User Hasnt Worked In The Workbook For X Minutes



accell
08-29-2013, 04:55 PM
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
08-30-2013, 12:47 AM
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
08-30-2013, 08:42 AM
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
08-30-2013, 09:59 AM
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
08-30-2013, 10:07 AM
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
08-30-2013, 10:48 AM
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. :dunno

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

p45cal
08-30-2013, 12:38 PM
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
08-30-2013, 01:08 PM
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
08-30-2013, 01:21 PM
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
08-30-2013, 01:44 PM
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
08-31-2013, 10:53 AM
Ken,

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

Enquiring minds want to know. :giggle

Kenneth Hobs
08-31-2013, 11:31 AM
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
08-31-2013, 02:00 PM
@ Ken, :thumb

@ 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
http://www.vbaexpress.com/forum/images/smilies/banghead.gifhttp://www.vbaexpress.com/forum/images/smilies/banghead.gifhttp://www.vbaexpress.com/forum/images/smilies/banghead.gif

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
08-31-2013, 03:17 PM
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
08-31-2013, 04:06 PM
:doh: 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
09-03-2013, 10:27 AM
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
09-03-2013, 03:29 PM
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
09-03-2013, 04:50 PM
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
09-03-2013, 06:40 PM
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
09-04-2013, 01:24 AM
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).

Kenneth Hobs
09-04-2013, 06:42 AM
I would do as Sam said. Skip the code if lcase(ThisWorkbook.Name)<>lcase("whateveryoucallthetemplate.xlsm"). This will always work as Excel can never have two workbooks with the same name open at once.