how to send system message every 15 mins - tough one

A

anglian

New Member
Joined
Nov 15, 2005
Messages
2
Hi,

I am on Windows NT and am trying for this - If a shared excel workbook is kept open by an User for more than 15minutes it should send a system message (note that the Excel may not be the active application on his desktop). If the user closes that is fine. Otherwise it should repeat every 15minutes.

Can anyone help on this? :confused: :confused: :confused:
 

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.
Sort by date Sort by votes
Anglian,

I use the following code to accomplish what you want. The following will automatically close and save the workbook if inactive for 1 minute (you specify time). A userform will pop-up informing the user the sheet is about to close. A time counts down from twenty, then saves and closes the workbook.

In a module, place this code:

Option Explicit
Const sec = 1 / 60 / 60 / 24
Public BootTime As Date
Public Timer2Active As Boolean

Sub StartTimer()
' Start the Activity Timer
BootTime = Now + TimeValue("00:01:00")
' If the Activity Timer runs for the specified time
' call the "CloseBook" sub
Application.OnTime BootTime, "CloseBook"
End Sub

Sub CloseBook()
' At this point the main Timer has elapsed.
' Display and let the UserForm take charge.
Application.WindowState = xlMaximized
UserForm1.Show
End Sub

Sub ReallyCloseBook()
If Timer2Active = False Then Exit Sub
Unload UserForm1
'End
ThisWorkbook.Save
Application.Quit
ThisWorkbook.Close
End Sub

Private Sub count_down()
'Seconds on Userform1
Dim CD As Range
Dim BC As Range
Set CD = ThisWorkbook.Sheets("Sheet2").Range("A1")
Set BC = ThisWorkbook.Sheets("Sheet2").Range("B1")
UserForm1.Label3 = ThisWorkbook.Sheets("Sheet2").Range("B1").Value
CD = CD - sec
BC = BC - 1
If CD > 0 Then
Application.OnTime Now + sec, "count_down"
Else
End If
End Sub



PLACE THIS CODE IN WORKSHEET 1 CODE:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' Check to see if the UserForm Timer is active.
' If it is, it has control, just exit this event without doing anything.
If Timer2Active = True Then Exit Sub
Application.OnTime BootTime, "CloseBook", , False
StartTimer
End Sub

PLACE THIS CODE IN YOUR WORKBOOK OPEN CODE:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Application.OnTime earliesttime:=BootTime, _
procedure:="CloseBook", schedule:=False
End Sub

Private Sub Workbook_Open()
StartTimer
End Sub

CREATE A USERFORM1 AND PLACE THIS CODE IN IT:

Private Sub UserForm_Activate()
ThisWorkbook.Sheets("Sheet2").Range("A1") = "00:00:20"
ThisWorkbook.Sheets("Sheet2").Range("B1") = 20
count_down
' Set the Timer2Active Flag to True.
' This stops the SheetSelectionFlag from processing it's code
' This UserForm now has control over what will be done next.
Timer2Active = True
' Start a timer within this UserForm. If the allotted time elapses
' without pressing the CommandButton, call "ReallyCloseBook"
Application.OnTime Now + TimeValue("00:00:20"), "ReallyCloseBook"
End Sub

Private Sub count_down()
'Seconds on Userform1
Dim CD As Range
Dim BC As Range
Set CD = ThisWorkbook.Sheets("Sheet2").Range("A1")
Set BC = ThisWorkbook.Sheets("Sheet2").Range("B1")
UserForm1.Label3 = ThisWorkbook.Sheets("Sheet2").Range("B1").Value
CD = CD - sec
BC = BC - 1
If CD > 0 Then
Application.OnTime Now + sec, "count_down"
Else

End If
End Sub


CREATE A BUTTON ON THAT USERFORM1 AND PLACE THIS CODE:

Private Sub CommandButton1_Click()
' Set the Timer2Active flag to False in order that the
' SheetSelectionChange Event can monitor activity.
Timer2Active = False
' Restart the Main timer again
StartTimer
' Dispense with the UserForm
Unload UserForm1
End
End Sub

YOU WILL ALSO NEED A LABEL ON THE USERFORM CALLED LABEL3
This is what shows the count down when the sheet is inactive.

Hope this helps :cool:
 
Upvote 0
thanks Dweeb458! Will try that and let you know

Dweeb458, thats quite lot of code. Will try that and let you know. Thanks for that :rolleyes:
 
Upvote 0
Code not working - Pls. help

Hi,

I am anglian. I am back from holiday and forgot my password and email-id I provided :unsure:

The code Dweeb458 provided is good but its not working. I am getting the below error in Worksheet_SelectionChange function.

Error: Method 'OnTime' of Object '_Application' failed
Statement: Application.OnTime BootTime, "CloseBook", , False

This happens after I click on the commandbutton to continue using the sheet and editing the worksheet. I have noticed that the variable BootTime is having value 00:00:00.

Also if I don't edit the worksheet, and let the timer expire, whole MS Excel application closes, not just this workbook.

This is not my assignment but I am doing for the benefit of my team. Please help.

Thanks alot
 
Upvote 0
Are you speaking of a broadcast via the windows API? If so, please define your message and also the version(s) of Excel that are going to use this.
 
Upvote 0
sujy,

I could not get that code to work properly. There is something going on with the 2 Timer Events. 1 of them will not stop. 1 timer event is triggered when the inactive timeframe had expired (Say 5 minutes). The second timer was used for the countdown. If the User happened to see the countdown, they could stop the worksheet from being closed. If they were away from thier desk, the form would just save and close.

I could never understand why the use of 2 timers was not working, and I apologize for sharing information that was not working properly.

This is the code that I use now. If the workbook is inactive for 10 minutes, the code simply save & closes the workbook with no warning to the user:

Code: 
'PLACE THIS CODE IN THE WORKBOOK OPEN Module:
'******************************************
Private Sub Workbook_Open()
'Start the Timer
    Call StartTime

End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Stop the Timer
    Call Disable
End Sub



'PLACE THIS CODE IN MODULE 1:
'******************************

Dim BootTime As Date

Sub StartTime()
'Start the Timer
    BootTime = Now + TimeValue("00:10:00")       'Set your time here
        Application.OnTime BootTime, "ShutDown"
End Sub

Sub ShutDown()
'At this point the main timer has elapsed.
    Application.WindowState = xlMaximized 'Maximize window
    ThisWorkbook.Save
    ThisWorkbook.Close
End Sub

Sub Disable()
'Stop the Timer
    On Error Resume Next
    Application.OnTime EarliestTime:=BootTime, _
        Procedure:="ShutDown", Schedule:=False
        
End Sub


'PLACE THIS CODE IN THE SHEET1 MODULE:
'***************************************


Option Explicit
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'Reset the Timer
    Call Disable
    Call StartTime
End Sub

I would rather the user be warned the workbook is about to be closed, but I could never find out why the two timers would not function together.

Again I apologize for the bad code. This board is an incredible resource of information. If someone can solve the problem of the two timers, Sujy and I would be much appreciative.

I'm using Windows XP & Excel2002

Thankyou Board
 
Upvote 0
Hi Dweeb458,
For now I will be fine with one timer. I slightly modified your first code to below but its not working. I think it is opening the application (spreadsheet) again. I will be grateful if you can look at it. Thanks a bunch. Cheers!!!

VBA Module:
-------------
Dim BootTime As Date

Sub StartTime()
BootTime = Now + TimeValue("00:00:10")
Application.OnTime BootTime, "CloseMsg"
End Sub

Sub CloseMsg()
Application.WindowState = xlMaximized 'Maximize window
UserForm1.Show
' If no activity for 5 seconds, Save & Close the application
Application.OnTime Now + TimeValue("00:00:05"), "UnloadUserForm"
ThisWorkbook.Save
ThisWorkbook.Close
End Sub

Sub ShutDown()
'At this point the main timer has elapsed.
Application.WindowState = xlMaximized 'Maximize window
ThisWorkbook.Save
ThisWorkbook.Close
End Sub

Sub Disable()
'Stop the Timer
On Error Resume Next
Application.OnTime EarliestTime:=BootTime, _
Procedure:="ShutDown", Schedule:=False
End Sub

Private Sub UnloadUserForm()
Unload UserForm1
End Sub

Userform code:
----------------
Private Sub UserForm_Activate()
Application.OnTime Now + TimeValue("00:00:05"), "UnloadUserForm"
ThisWorkbook.Save
ThisWorkbook.Close
End Sub

Private Sub CommandButton1_Click()
' User want to continue using the application
Unload UserForm1
Call Disable
Call StartTime
End Sub

Private Sub CommandButton2_Click()
' User don't want to continue using the application
Unload UserForm1
ThisWorkbook.Save
ThisWorkbook.Close
End Sub

Other code:
------------
Private Sub Workbook_Open()
...
Call StartTime


Private Sub Worksheet_Change(ByVal Target As Range)
...
'Reset the Timer
Call Disable
Call StartTime

### END ###
 
Upvote 0
Sujy,

The code you modified is still using a userform and two timers. The two timers is what has been reopening the application again. One of the timers is not be fully disabled.

Use the code from the above post within your workbook. This is the code that I now use. It contains only 1 timer. If a user opens the my workbook, then opens another application or leaves their desk,etc..., once my workbooks timer has expired, it will save and close the workbook automatically. This has save me quite a bit of time and frustration from trying to get the user to close the workbook. Many times the user would be away from thier desk, so calling the user on the phone was of no use. Since I've implemented these changes, all has been well.

Dweeb458 :biggrin:
 
Upvote 0
if you put this code somewhere in your workbook:
(preferably inside a module)

Code: 
Private TimeLeft As Integer
Private MinutesBeforeMessage As Integer
Private IsChanged As Boolean

Public Sub IChanged()

    IsChanged = True

End Sub


Public Sub SetCloseTimer(m_MinutesBeforeMessage As Integer)

    MinutesBeforeMessage = m_MinutesBeforeMessage
    TimeLeft = MinutesBeforeMessage

    Application.OnTime Now + TimeValue("00:01:00"), "ProcessTimer"

End Sub

Public Sub ProcessTimer()

    TimeLeft = TimeLeft - 1
    
    If IsChanged Then TimeLeft = MinutesBeforeMessage
    
    If TimeLeft <= 0 Then
    
        PostMessage
        TimeLeft = MinutesBeforeMessage
    
    End If
    
    Application.OnTime Now + TimeValue("00:01:00"), "ProcessTimer"

End Sub

Public Sub PostMessage()

    MsgBox "YO!"

End Sub

this code into the workbook code:

Code: 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    IChanged

End Sub

you can run this code to activate the timer:

Code: 
SetCloseTimer (15)

edit the message to fit your needs :)
 
Upvote 0
Hi, I am looking for a way to just repeat a message "You have been idle for 10 minutes, please save and close now." I do NOT want to close the workbook, but just to repeat the message pop-up every 10 minutes. I've searched and searched and have not found code to do this. Any help out there?
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question
Help on how to update this code to have it send to recipients in Cell Value
Replies
1
Views
821
agutosay
A
S
  • Question
Create a Recursive VBA to call itself and create mass files
Replies
1
Views
491
seigen
S
A
  • Question
VBA Code help: TO: CC: BCC in Mail Merge
Replies
0
Views
2K
agutosay
A
S
  • Question
personal.xlsb code to set full path in title bar works on one computer but not another
Replies
0
Views
620
Special K
S
S
  • Solved
Seperate Data In One Cell Across Multiple Cells
Replies
6
Views
1K
Alex Blakenburg
A

Forum statistics

Threads
1,214,525
Messages
6,120,052
Members
448,940
Latest member
mdusw

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top