automatic close excel workbook with a pop up message
<p>I am trying to create a macro that can automatically close the workbook within 5 minutes plus there will be a pop up reminder message at 4 mins 30 sec. I want the message box to be automatically closed in 10 seconds if user does not click the ok button. I am stuck at the point that the message box cannot close within 10 seconds. Most of my code are copied from the internet. Below are my codes:</p>

<p>In the workbook page:</p>

<pre><code>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
</code></pre>

<p>In the module</p>

<pre><code>Dim downtime As Date

Sub settimer()

    downtime = Now + TimeValue("00:01:00")

    alerttime = downtime - TimeValue("00:00:50")

    Application.OnTime Earliesttime:=alerttime, _
    procedure:="alertuser", schedule:=True

    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 = True

    With ThisWorkbook

        .Save = True

        .Close

    End With

End Sub

Sub alertuser()

    Dim wsshell

    Dim intText As Integer

    Set wsshell = CreateObject("WScript.Shell")

    intText = wsshell.Popup("log sheet will be closed in 30 seconds if there are no more inputs", 10, "reminder")

    Set wsshell = Nothing

End Sub
</code></pre>