automatic close excel workbook with a pop up message

Question

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:

In the workbook page:

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

In the module

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

Answer 1

Thanks, John Coleman for your answer. It led me to a solution I've wanted for a long time. I took your code and converted it into a generic function that accepts parameters for the message and the number of seconds to wait.

Sub MsgBoxTimerTest()
' Test the Message box with a timer form
Dim vReturn As Variant
vReturn = MsgBoxTimerCall("MessageBox that Dissappears after n Seconds", "Hello World!", 3)
End Sub
' **************************************************************************

Function MsgBoxTimerCall(strCaption As String, strMessage As String, intSeconds As Integer)
' Show a messagebox for a while
' https://stackoverflow.com/questions/37281840/automatic-close-excel-workbook-with-a-pop-up-message
' 2016-06-21
TimerSeconds = intSeconds
msgBoxTimerForm.Caption = strCaption
msgBoxTimerForm.TextBox1.Value = strMessage
msgBoxTimerForm.Show
End Function
' **************************************************************************

' **************************************************************************
Insert this code in the form
' **************************************************************************
Private Running As Boolean

Private Sub CommandButton1_Click()
    MsgBox "Yo!"
    Running = False
End Sub

Private Sub UserForm_Activate()
    Dim start As Single
    start = Timer
    Running = True
    Do While Running And Timer < start + TimerSeconds
        DoEvents
    Loop
    Unload Me
End Sub

Private Sub UserForm_Click()
    Running = False
End Sub

Answer 2

You could use a userform (which you Insert into your project in the VBA editor) which looks something like this:

In the properties window I changed the forms name to formReminder to make it easier to refer to in other modules. Then, in the userform's code window I put:

Private Running As Boolean

Private Sub CommandButton1_Click()
    Running = False
End Sub

Private Sub UserForm_Activate()
    Dim start As Single
    start = Timer
    Running = True
    Do While Running And Timer < start + 10
        DoEvents
    Loop
    Unload Me
End Sub

Private Sub UserForm_Click()
    Running = False
End Sub

When you run the line formReminder.Show anywhere else in the code (e.g. -- in place of where you create the popup) the form will display and show for 10 seconds (or less if you click anywhere on it) and then disappear.

While it displays it will look like this:

Answer 3

You need to fully qualify your procedure name. It is not finding the procedure in question. You also had a typo and where missing the global variable alerttime. Try this:

Public downtime As Date
Public alerttime As Date

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    

Sub settimer()

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

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

    'fully qualify your procedure name here and the procedure will run
    Application.OnTime Earliesttime:=alerttime, _
    procedure:="WorkbookName.xlsm!ThisWorkbook.alertuser", schedule:=True

    'and here... also typo was here in downtime
    Application.OnTime Earliesttime:=downtime, _
    procedure:="WorkbookName.xlsm!ThisWorkbook.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