VBA to close workbook after 10minutes of inactivity

[brianv]

I have a shared workbook on our server that is used by numerous people, problem is that someone opens it and leaves it open then goes to lunch, so no one else can edit it. So id like to close it after 10 minutes on inactivity.

Can I get help on writing a VBA code to close a workbook after 10 minutes of inactivity? Is it possible to open a dialog box to remind the user its about to close.

 

[Logit]

Paste the following into a regular module :

Option Explicit

Dim DownTime As Date

Sub SetTimer()
    DownTime = Now + TimeValue("00:10:00")  ''<--- change time to close here
    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

Paste the following in the ThisWorkbook module :

Option Explicit

Private Sub Workbook_Open()
    Call SetTimer
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call StopTimer
    Application.DisplayAlerts = False
    ThisWorkbook.Saved = True
    Application.Visible = False
    Application.Quit
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

As designed, the macro will auto start when the workbook is opened. And close after 10 minutes of inactivity.

 

[brianv]

Ho Logit,
That works well, but is it possible to get a popup to display for 1minute prior to the actual close that it is about to close for inactivity?

I notice the workbook is not saving on close, so i modified the Shutdown sub to:

Sub ShutDown()

    Application.DisplayAlerts = False
    'With ThisWorkbook
        '.Saved = True
        '.Close
    'End With
    ActiveWorkbook.Save
    ActiveWorkbook.Close
  
End Sub

 

[Logit]

The following will accomplish your desired goal. However, consider the warning message will pop-up approx. 1 minute before the workbook is scheduled to close. The
warning message will hang in front of the workbook waiting for the user to take action. So long as the message is displayed it will halt all activity involving the workbook.
This is not going to accomplish your goal. Once again you will be dealing with a workbook that no one can access ... just as it is now without taking any action.

Although it may seem harsh, the best practice would be to simply let the workbook close by itself. No warning. The employees will be advised of such when you go live
with the new workbook. It has been and will continue to be their responsibility to lend courtesy to their co-workers.

Paste in a regular module:

Dim DownTime As Date

Sub SetTimer()
    DownTime = Now + TimeValue("0:10: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()
    If CreateObject("WScript.Shell").PopUp("Close Excel?", 90, "Excel", vbOKCancel + vbQuestion + vbSystemModal) = vbCancel Then
        StopTimer
        SetTimer
        Exit Sub
    End If
    Application.DisplayAlerts = False
    'When used in a workbook this makes Excel invisible.
    Application.Visible = False
    Workbooks("Auto Close w Warning.xlsb").Close SaveChanges:=True
  
   Application.DisplayAlerts = True
End Sub

Paste in ThisWorkbook 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

 

[brianv]

Understood, thank you for your help... its working great w/o the added message.

 

[Logit]

You are welcome. Glad to assist.