Close Workbook after 30 minutes automatically

[eli_m]

Hi,

I am getting this error:

For:

Module Code:

Option Explicit
Public Close_Time As Date
Sub start_Countdown()
    Close_Time = Now() + TimeValue("00:30:00")
    Application.OnTime Close_Time, "close_WB"
    End Sub
Sub stop_Countdown()
    Application.OnTime Close_Time, "close_WB", , False
    End Sub
Sub close_wb()
    ThisWorkbook.Save
If Application.Wait(Now + TimeValue("00:00:05")) = True Then
    MsgBox "Timed out after 30 minutes - Your work has been saved."
End If
    ThisWorkbook.Close
    End Sub

Workbook:

Top of code:

Option Explicit
Private Sub Workbook_Open()
    start_Countdown

.........

Bottom of code:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    stop_Countdown
    start_Countdown
    End Sub

I only want the workbook to close when there has been no SheetChanges in the last 30 minutes. I want the timer to restart every time there is a SheetChange. Right now it is closing at 30minutes from opening.

Can anyone see what the problem is?

Thanks in advance!

 

[johnnyL]

I think this idea would require two different modules being added, One to the 'ThisWorkbook' module and another to a regular module.

It appears that you want to save the workbook before closing it? Are you sure?

 

[eli_m]

I think this idea would require two different modules being added, One to the 'ThisWorkbook' module and another to a regular module.

It appears that you want to save the workbook before closing it? Are you sure?

Firstly, thanks for the reply!

I thought I had two different modules? One is running in the workbook and one as regular.

I do want to save the changes to the workbook before closing - I even have a 5-second pause to make sure the workbook saves. Is there something wrong with that? The document is shared and has autosave on. I pretty much just want to kick off inactive users

 

[johnnyL]

What I was trying to get at is, if someone has made some changes that may not be desirable, and the time expires, the undesired changes will be saved.

 

[eli_m]

What I was trying to get at is, if someone has made some changes that may not be desirable, and the time expires, the undesired changes will be saved.

It's all on OneDrive so I can go back a version - Are you able to help with the first error? Its the module that is by itself (right now I've commented it out so I can continue using the document):

 

[johnnyL]

You could try the following code:

In the 'ThisWorkbook' module, copy/paste the following:

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

Then, in a regular module copy/paste the following:

Dim DownTime As Date

Sub SetTimer()
    DownTime = Now + TimeValue("00:30:00")                                                      ' This sets the timer for 30 minutes of inactivity
    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
        Application.DisplayAlerts = False
        .Close Savechanges:=True
        Application.DisplayAlerts = True
    End With
End Sub

 

[eli_m]

You could try the following code:

In the 'ThisWorkbook' module, copy/paste the following:

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

Then, in a regular module copy/paste the following:

Dim DownTime As Date

Sub SetTimer()
    DownTime = Now + TimeValue("00:30:00")                                                      ' This sets the timer for 30 minutes of inactivity
    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
        Application.DisplayAlerts = False
        .Close Savechanges:=True
        Application.DisplayAlerts = True
    End With
End Sub

That seems to do the trick perfectly! Do you know where I can add in "MsgBox "Timed out after 30 minutes - Your work has been saved."" ?

I want that dialogue to pop up so they know they have been kicked. Thanks again!

 

[johnnyL]

Place it in the 'Sub ShutDown'

Sub ShutDown()
'
    With ThisWorkbook
        Application.DisplayAlerts = False
        .Close Savechanges:=True
        Application.DisplayAlerts = True
    End With
'
    MsgBox "Timed out after 30 minutes - Your work has been saved."
End Sub

 

[eli_m]

Place it in the 'Sub ShutDown'

Sub ShutDown()
'
    With ThisWorkbook
        Application.DisplayAlerts = False
        .Close Savechanges:=True
        Application.DisplayAlerts = True
    End With
'
    MsgBox "Timed out after 30 minutes - Your work has been saved."
End Sub

Thank works now to - You're amazing.

I have actually moved the Code for the work book just on the sheet thats mostly used (only I use the other sheets). How can I make it so the timer doesn't run when I am on another sheet?

I tried:

Private Sub Worksheet_Activate()
   
  Call StopTimer
  ThisWorkbook.RefreshAll ' Auto Refresh Pivot Tables
 
On Error Resume Next

End Sub

and it still kicked me out

 

[johnnyL]

It sounds like you are trying to defeat the purpose of your original question. Wrap this thread up and start a new thread if you want to only monitor inactive time on a specific sheet.