Force a Message Box to close unanswered

[jennie]

Hi,

One of the spreadsheets we have has the problem that it keeps being left open, I therefore want it to close after a set time, but if their is someone working on the spreadsheet I would like it to ask them to press OK to keep it open before it closes.
However once the question is asked it just hangs there until OK is pressed.
I would like it to close if the question hasn't been answered (OK pressed) in about 30 seconds.
Does anyone know how to do this?

This is the code I am using at the moment:



Private Sub Counter()
THE_COUNT = THE_COUNT + 1

If THE_COUNT > 5 Then
Debug.Print "The Time is: " & Now()
Debug.Print "Count is: " & THE_COUNT
Debug.Print "Ending"

Dim Response As Variant
Response = MsgBox("Click OK to keep open", vbExclamation + vbOKOnly, "Closing")

If Response = vbOK Then
THE_COUNT = 1
Call Application.OnTime(Now() + TimeValue("00:01:00"), "Counter")
Else
' Want it to carry on and close if the message hasn't been answered in 30 secs
Call Workbooks("CloseOnTime.xls").Close(True)
End If


ElseIf THE_COUNT = 0 Then
Debug.Print "The Time is: " & Now()
Debug.Print "Count is: " & THE_COUNT
Debug.Print "Ending 0"
Exit Sub

Else
Debug.Print "The Time is: " & Now()
Debug.Print "Count is: " & THE_COUNT
Call Application.OnTime(Now() + TimeValue("00:01:00"), "Counter")
End If

End Sub


Thanks for your help
Jennie

[Norman Jones]

Hi Jennie,

See Chip Pearson's Timed Msgbox post:

http://tinyurl.com/c36y8

---
Regards,
Norman



"jennie" <[email protected]> wrote in
message news:[email protected]...
>
> Hi,
>
> One of the spreadsheets we have has the problem that it keeps being
> left open, I therefore want it to close after a set time, but if their
> is someone working on the spreadsheet I would like it to ask them to
> press OK to keep it open before it closes.
> However once the question is asked it just hangs there until OK is
> pressed.
> I would like it to close if the question hasn't been answered (OK
> pressed) in about 30 seconds.
> Does anyone know how to do this?
>
> This is the code I am using at the moment:
>
>
>
> Private Sub Counter()
> THE_COUNT = THE_COUNT + 1
>
> If THE_COUNT > 5 Then
> Debug.Print "The Time is: " & Now()
> Debug.Print "Count is: " & THE_COUNT
> Debug.Print "Ending"
>
> Dim Response As Variant
> Response = MsgBox("Click OK to keep open", vbExclamation +
> vbOKOnly, "Closing")
>
> If Response = vbOK Then
> THE_COUNT = 1
> Call Application.OnTime(Now() + TimeValue("00:01:00"),
> "Counter")
> Else
> ' Want it to carry on and close if the message hasn't been
> answered in 30 secs
> Call Workbooks("CloseOnTime.xls").Close(True)
> End If
>
>
> ElseIf THE_COUNT = 0 Then
> Debug.Print "The Time is: " & Now()
> Debug.Print "Count is: " & THE_COUNT
> Debug.Print "Ending 0"
> Exit Sub
>
> Else
> Debug.Print "The Time is: " & Now()
> Debug.Print "Count is: " & THE_COUNT
> Call Application.OnTime(Now() + TimeValue("00:01:00"), "Counter")
> End If
>
> End Sub
>
>
> Thanks for your help
> Jennie
>
>
> --
> jennie
> ------------------------------------------------------------------------
> jennie's Profile:
> http://www.excelforum.com/member.php...fo&userid=6706
> View this thread: http://www.excelforum.com/showthread...hreadid=475326
>