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