Отображение окна сообщения со значением тайм-аута

Вопрос исходит из такого кода.

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

Это простой способ отобразить окно сообщения с таймаутом от VBA (или VB6).

В Excel 2007 (по всей видимости, иногда это случается и в Internet Explorer) всплывающее окно не истекает по таймауту, а вместо этого ожидает ввода данных пользователем.

Эту проблему сложно отладить, так как это случается только изредка, и я не знаю шаги для воспроизведения проблемы. Я считаю, что это проблема с модальными диалоговыми окнами Office, а Excel не распознает время ожидания истекло.

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

Я нашел обходные пути:

A. Используйте вызов Win32 API

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. Используйте ручной таймер с пользовательской формой VBA, которая выглядит как окно сообщения. Используйте глобальную переменную или что-то подобное, чтобы сохранить любое состояние, которое необходимо передать обратно в вызывающий код. Убедитесь, что метод Show формы пользователя вызывается с предоставленным параметром vbModeless.

C. Оберните вызов метода wscript.popup в процессе MSHTA, что позволит коду выйти за пределы процесса и избежать модального характера Office.

CreateObject("WScript.Shell").Run "mshta.exe vbscript:close(CreateObject(""WScript.Shell"").Popup(""Test"",2,""Real%20Time%20Status%20Message""))"

Как лучше всего отобразить A, B или C или ваш собственный ответ окно сообщения со значением тайм-аута в VBA?