Display a message box with a timeout value

The question comes from code like this.

Set scriptshell = CreateObject("wscript.shell")
    Const TIMEOUT_IN_SECS = 60
    Select Case scriptshell.popup("Yes or No? leaving this window for 1 min is the same as clicking Yes.", TIMEOUT_IN_SECS, "popup window", vbYesNo + vbQuestion)
        Case vbYes
            Call MethodFoo
        Case -1
            Call MethodFoo
    End Select

This is a simple way to display a message box with a timeout from VBA (or VB6).

In Excel 2007 (apparently also happens in Internet Explorer at times) the popup window will not timeout, and instead wait for user input.

This issue is tough to debug as it only happens occasionally and I do not know the steps to reproduce the issue. I believe it to be an issue with Office modal dialogs and Excel not recognising the timeout has expired.

See http://social.technet.microsoft.com/Forums/en-US/ITCG/thread/251143a6-e4ea-4359-b821-34877ddf91fb/

The workarounds I found are:

A. Use a Win32 API call

Declare Function MessageBoxTimeout Lib "user32.dll" Alias "MessageBoxTimeoutA" ( _
ByVal hwnd As Long, _
ByVal lpText As String, _
ByVal lpCaption As String, _
ByVal uType As Long, _
ByVal wLanguageID As Long, _
ByVal lngMilliseconds As Long) As Long

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

Public Sub MsgBoxDelay()
    Const cmsg As String = "Yes or No? leaving this window for 1 min is the same as clicking Yes."
    Const cTitle As String = "popup window"
    Dim retval As Long
    retval = MessageBoxTimeout(FindWindow(vbNullString, Title), cmsg, cTitle, 4, 0, 60000)

    If retval <> 7 Then
        Call MethodFoo
    End If

End Sub  

B. Use a manual timer with a