timer re-opening spread sheet when other spreadsheets are open

[Footballtend]

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,

 

[Logit]

I believe after the MsgBox display ... you should include a line for StopTimer. Otherwise the timer will continue to run and 15 minutes later, the
MsgBox shows again.

I would also include a line after the MsgBox and StopTimer to auto-close the workbook without user interaction.

 

[Logit]

After further thought ... the MsgBox is a MODAL form. Meaning ... it takes complete control of the system and will not disappear unless the USER clicks on it.

You can circumvent this by replacing the MsgBox with an ordinary USERFORM designed by you to look like a MsgBox. And make the USERFORM Non-Modal.
Then the auto-close would work.

Another approach is to utilize a Win 32 based macro that displays your message / s and then auto-closes. Here is sample code to that effect and the resource.
It has been tested here and works.

How do I close a currently opened MsgBox using VBA?

Declare Function MessageBoxTimeout Lib "user32.dll" Alias "MessageBoxTimeoutA" ( _
    ByVal hwnd As Long, _
    ByVal lpText As String, _
    ByVal lpCaption As String, _
    ByVal uType As Long, _
    ByVal wLanguageID As Long, _
    ByVal lngMilliseconds As Long) As Long

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
    ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long

Public Function PopUpBox(Optional stMessage As String _
        = "Yes or No? leaving this window for 1 min is the same as clicking Yes.", _
        Optional stTitle As String = "PopUp Window", _
        Optional HalfSecTimer As Long = 120, Optional lgVBmsgType As Long = vbYesNo) As Long

    Dim RetVal As Long

    HalfSecTimer = HalfSecTimer * 500
    RetVal = MessageBoxTimeout(FindWindow(vbNullString, Title), stMessage, stTitle, lgVBmsgType, _
        0, HalfSecTimer)

    PopUpBox = RetVal
End Function

Sub CallMsgBox()
'Dim intAnswer
PopUpBox "Re-Linking and Closing dB", "Closing dB", 3, vbOKOnly
intAnswer = PopUpBox("Software Lock Down Active?", "Security", 10, vbYesNo)
End Sub

 

[Footballtend]

After further thought ... the MsgBox is a MODAL form. Meaning ... it takes complete control of the system and will not disappear unless the USER clicks on it.

You can circumvent this by replacing the MsgBox with an ordinary USERFORM designed by you to look like a MsgBox. And make the USERFORM Non-Modal.
Then the auto-close would work.

Another approach is to utilize a Win 32 based macro that displays your message / s and then auto-closes. Here is sample code to that effect and the resource.
It has been tested here and works.

How do I close a currently opened MsgBox using VBA?

Declare Function MessageBoxTimeout Lib "user32.dll" Alias "MessageBoxTimeoutA" ( _
    ByVal hwnd As Long, _
    ByVal lpText As String, _
    ByVal lpCaption As String, _
    ByVal uType As Long, _
    ByVal wLanguageID As Long, _
    ByVal lngMilliseconds As Long) As Long

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
    ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long

Public Function PopUpBox(Optional stMessage As String _
        = "Yes or No? leaving this window for 1 min is the same as clicking Yes.", _
        Optional stTitle As String = "PopUp Window", _
        Optional HalfSecTimer As Long = 120, Optional lgVBmsgType As Long = vbYesNo) As Long

    Dim RetVal As Long

    HalfSecTimer = HalfSecTimer * 500
    RetVal = MessageBoxTimeout(FindWindow(vbNullString, Title), stMessage, stTitle, lgVBmsgType, _
        0, HalfSecTimer)

    PopUpBox = RetVal
End Function

Sub CallMsgBox()
'Dim intAnswer
PopUpBox "Re-Linking and Closing dB", "Closing dB", 3, vbOKOnly
intAnswer = PopUpBox("Software Lock Down Active?", "Security", 10, vbYesNo)
End Sub

Thanks Logit for the responses. Some clarification, We want it to remind the user every 15 minutes that they have the workbook open. Since it is a shared workbook, people will work in it, for say 20 minutes, and forget to close it. (which the second timer at 30 minutes would prompt them to close it then). But it is a protected workbook on a share-site so auto-closing it will loose all the changes they made, so we can not auto close it.

 

[Logit]

You can include a line in the macro to save the workbook prior to auto-close.

 

[Footballtend]

You can include a line in the macro to save the workbook prior to auto-close.

There is a "check in" step built into the Share-site that the auto save / auto close, does not trigger.

 

[Logit]

Sorry ... I don't understand the "check in" step. You already have the timer initiated when the workbook is opened. That is all you need to begin with and
it already occurs after the "check in step".

Now you can change the macro / s to accommodate your additional needs.

Give it a go and come back when you need additional assistance with a specific question.

 

[Footballtend]

Other than stopping the timer after the first time it goes off, Is there a way i can keep the code from reopening the workbook? It can not auto save and auto close.

 

[Logit]

Not that I am aware of. Once the timer is initiated, it will continue to run unless it has been purposely stopped.

Your posted code tells it to display the MsgBox. Then the user closes the MsgBox but the code as written does not stop the timer.

 

[ZVI]

Put this code into class module (VBE-Insert-Class Module).
Press F4 and rename that class module from Class1 to clsTimedClose.

' ZVI:2021-04-14 https://www.mrexcel.com/board/threads/timer-re-opening-spread-sheet-when-other-spreadsheets-are-open.1167993/
' Put the below code into the clsTimedClose class module (VBA - Insert - Class Module, use F4 to rename it)
Option Explicit

#If VBA7 Then
  Private Declare PtrSafe Function MessageBoxTimeOut Lib "user32" Alias "MessageBoxTimeoutA" (ByVal hWnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal uType As VbMsgBoxStyle, ByVal wLanguageId As Long, ByVal dwMilliseconds As Long) As Long
  Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
  Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
  Dim TimerID As LongPtr
#Else
  Private Declare Function MessageBoxTimeOut Lib "User32" Alias "MessageBoxTimeoutA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal uType As VbMsgBoxStyle, ByVal wLanguageId As Long, ByVal dwMilliseconds As Long) As Long
  Private Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
  Private Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
  Dim TimerID As Long
#End If
Private Const KEYEVENTF_KEYUP = &H2
Private Const DefaultInactiveSeconds As Long = 15 * 60  ' Idle time before asking to close workbook
Private Const DefaultShowSeconds As Long = 60           ' Time to show the warning message
Private Const DefaultPrompt As String = "Workbook will be closed without saving changes!"

Dim WithEvents objWb As Workbook
Dim lngInactiveSeconds As Long, lngAskSeconds As Long
Dim strPrompt As String
Dim varCallbackAddress As Variant
Dim blnSaveChanges As Boolean

Private Sub Class_Initialize()
' Set default parameters
  lngInactiveSeconds = DefaultInactiveSeconds
  lngAskSeconds = DefaultShowSeconds
  strPrompt = DefaultPrompt
  Set objWb = ActiveWorkbook
End Sub

Private Sub Class_Terminate()
  StopTimer
End Sub

Public Sub Init(Wb As Workbook, CallbackAddress)
   Set objWb = Wb
   varCallbackAddress = CallbackAddress
   StartTimer
End Sub

Property Let InactiveSeconds(Seconds As Long)
  lngInactiveSeconds = Seconds
  If lngInactiveSeconds > 86400 Then lngInactiveSeconds = 86400
End Property

Property Let AskSeconds(Seconds As Long)
  lngAskSeconds = Seconds
  If lngAskSeconds > 86400 Then lngAskSeconds = 86400
End Property

Property Let Prompt(Msg As String)
  strPrompt = Msg
End Property

Property Let SaveChanges(IsSave As Boolean)
  blnSaveChanges = IsSave
End Property

Private Sub StartTimer()
  StopTimer
  If varCallbackAddress = 0 Or lngInactiveSeconds = 0 Then
    Err.Raise 5, , "An error creating the timer"
  Else
    TimerID = SetTimer(0&, 0&, lngInactiveSeconds * 1000&, varCallbackAddress)
  End If
End Sub

Private Sub StopTimer()
  If TimerID <> 0 Then
    KillTimer 0&, TimerID
    TimerID = 0
  End If
End Sub

Public Sub ShowMsg()
'Callled by the callback sub in standard module
  Dim ret
  Dim Msg As String
  Msg = strPrompt
  If Msg = DefaultPrompt And blnSaveChanges Then
    Msg = Replace(Msg, "without", "with")
  End If
  StopTimer
  On Error Resume Next
  objWb.Activate
  On Error GoTo 0
  ret = MessageBoxTimeOut(objWb.Application.hWnd, Msg, objWb.Name & " - It's time to close!", vbCritical + vbYesNo, 0&, lngAskSeconds * 1000&)
  If ret = vbNo Then
    StartTimer
  Else
    ThisWorkbook.Close SaveChanges:=blnSaveChanges
  End If
End Sub

' => Workbook's events to reset timer
Private Sub objWb_SheetActivate(ByVal Sh As Object)
  StartTimer
End Sub
Private Sub objWb_SheetCalculate(ByVal Sh As Object)
  StartTimer
End Sub
Private Sub objWb_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
  StartTimer
End Sub
'<= End of the reset timer events

The below code goes to the standard module (VBE-Insert-Module) .
Iddle time = 20 seconds and 30 seconds for the message are just to speed up the testing, change it to suit or use the default 15 minutes and 60 seconds accordingly.

' Put the below code into standard module (VBE - Insert - Module)
Option Explicit

Dim MyClass As clsTimedClose

Sub Auto_Open()
' This code runs automatically at workbook loading.
' You may run it manually at debugging time as well.

  ' This line is required
  Set MyClass = New clsTimedClose

  ' ==> Change Optional settings

    ' Close with/without saving changes. Default is False to close without saving changes
    MyClass.SaveChanges = True

    ' Prompt message. Default is "Workbook will be closed without saving changes!"
    ' or "... with saving changes!" if MyClass.SaveChanges = True
    MyClass.Prompt = "Workbook will be closed with saving changes"

    ' Idle time in seconds, default is 15*60 seconds = 15 minutes
    MyClass.InactiveSeconds = 20  ' 20 seconds to speed up testing

    ' Time to show warning message before workbook closing. Default is 60 seconds
    ' Choose No in the appeared dialog with message to continue workbook editing
    MyClass.AskSeconds = 15

  '<== End of changing optional setting

  ' This line is required
  MyClass.Init ThisWorkbook, AddressOf TimerCallBack

End Sub

Sub TimerCallBack()
' This sub is required
  MyClass.ShowMsg
End Sub

Sub StopTimer()
' For debug only
  Set MyClass = Nothing
End Sub

Without changing the optional settings (15 minutes iddle time, 30 seconds for the message, close without saving changes) the code in the standard module is simple as follows:

' Put the below code into standard module (VBE - Insert - Module)
Option Explicit

Dim MyClass As clsTimedClose

Sub Auto_Open()
' This code runs automatically at workbook loading.
' You may run it manually at debugging time as well.

  ' This line is required
  Set MyClass = New clsTimedClose
 
  ' This line is required
  MyClass.Init ThisWorkbook, AddressOf TimerCallBack

End Sub

Sub TimerCallBack()
' This sub is required
  MyClass.ShowMsg
End Sub

Sub StopTimer()
' For debug only
  Set MyClass = Nothing
End Sub