Footballtend
New Member
- Joined
- Apr 13, 2021
- Messages
- 5
- Office Version
- 2013
- Platform
- Windows
Hello,
I am not very familiar with VB, but doing some research I was able to get some code to make a timer that will let people know they have been in the workbook for 15 minutes by a message box. This is a shared spreadsheet. A few people have said that they will open the spread sheet, make changes, Save and close the workbook in under 15 minutes. Then when the 15 minutes elapses, the workbook will reopen. It only does this when there is another workbook open. Code is below. I did some digging but I cant seem to find the error.
I have this code in its entirety in "ThisWorkBook" and also is a Module.
-------------------------------------------
Option Explicit
Dim DownTime As Date
Sub workbook_open()
Call SetTimer
End Sub
Sub SetTimer()
DownTime = Now + TimeValue("00:15:00")
Application.OnTime EarliestTime:=DownTime, Procedure:="MsgBoxCriticalIcon", Schedule:=True
End Sub
Sub StopTimer()
On Error Resume Next
Application.OnTime EarliestTime:=DownTime, Procedure:="MsgBoxCriticalIcon", Schedule:=False
End Sub
Public Sub MsgBoxCriticalIcon()
MsgBox "Please close the file if no longer in use.", vbCritical
End Sub
----------------------------------------------------------------
If anyone could help it would be appreciated.
Thank you,
I am not very familiar with VB, but doing some research I was able to get some code to make a timer that will let people know they have been in the workbook for 15 minutes by a message box. This is a shared spreadsheet. A few people have said that they will open the spread sheet, make changes, Save and close the workbook in under 15 minutes. Then when the 15 minutes elapses, the workbook will reopen. It only does this when there is another workbook open. Code is below. I did some digging but I cant seem to find the error.
I have this code in its entirety in "ThisWorkBook" and also is a Module.
-------------------------------------------
Option Explicit
Dim DownTime As Date
Sub workbook_open()
Call SetTimer
End Sub
Sub SetTimer()
DownTime = Now + TimeValue("00:15:00")
Application.OnTime EarliestTime:=DownTime, Procedure:="MsgBoxCriticalIcon", Schedule:=True
End Sub
Sub StopTimer()
On Error Resume Next
Application.OnTime EarliestTime:=DownTime, Procedure:="MsgBoxCriticalIcon", Schedule:=False
End Sub
Public Sub MsgBoxCriticalIcon()
MsgBox "Please close the file if no longer in use.", vbCritical
End Sub
----------------------------------------------------------------
If anyone could help it would be appreciated.
Thank you,