Autoclose Excel Workbook with warning popup - vba

Question

I have a situation where multiple users will need to access a workbook (want to avoid using the 'Share Workbook' option due to all the problems). I've determined that a possible solution to this is to get the workbook to automatically close after 15 minutes of inactivity.
I would also like a message to pop up after the 15 minutes which alerts the user that unless they click the 'okay' button, the workbook will close. If they click the button, I would like the counter to start over, and ideally if they don't click anything the workbook will automatically closer after a further 1 minute.
I have found some code online which I have used. The workbook successfully closes after a specified time but I can't figure out how to get the message box to pop up. Would appreciate any help, thanks!
Code I used is below:
In module 1:
Dim DownTime As Date
Sub SetTimer()
DownTime = Now + TimeValue("0:15: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()
Application.DisplayAlerts = False
With ThisWorkbook
.Saved = True
.Close
End With
End Sub
And in ThisWorkbook:
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

Answer 1

Try the below ShutDown procedure:
Sub ShutDown()
If CreateObject("WScript.Shell").PopUp("Close Excel?", 60, "Excel", vbOKCancel + vbQuestion + vbSystemModal) = vbCancel Then
StopTimer
SetTimer
Exit Sub
End If
Application.DisplayAlerts = False
With ThisWorkbook
.Saved = True
.Close
End With
End Sub

Answer 2

Never 'share' Excel files on a network drive with coworkers. You will encounter all kinds of problems, including workbook corruption, and other things. Try this script, to auto-close your Excel files after n-minutes of inactivity.
To start, add the following code to a standard macro module. Note that there are three routines to be added:
Dim DownTime As Date
Sub SetTimer()
DownTime = Now + TimeValue("01:00: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()
Application.DisplayAlerts = False
With ThisWorkbook
.Saved = True
.Close
End With
End Sub
The next routines (there are four of them) need to be added to the ThisWorkbook object. Open the VBA Editor and double-click on the ThisWorkbook object in the Project Explorer. In the code window that Excel opens, place these routines:
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
See this for all info.
http://excelribbon.tips.net/T008192_Forcing_a_Workbook_to_Close_after_Inactivity.html