什么是显示带有VBA超时值的消息框的最佳方法？

Question

这个问题是关于下面列出的最佳解决方法,或者您知道的另一个问题.

这是问题的背景,它来自这样的代码......

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用户表单,其设计看起来像一个消息框.使用全局变量或类似函数来保存需要传递回调用代码的任何状态.确保使用提供的vbModeless参数调用userform的Show方法.

C.在MSHTA进程中包含对wscript.popup方法的调用,这将允许代码耗尽进程并避免办公室的模态性质.

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

这个问题是关于上面列出的最佳解决方法,或者您可能知道的另一个问题.那么在VBA中显示带超时值的消息框的最佳方法是什么？提名A,B或C或您自己的答案.

Answer 1

This is a long answer, but there's a lot of ground to cover: it's also a late reply, but things have changed since some of the replies to this (and similar questions) have been posted on the stack. That sucks like a vacuum cleaner on triple-phase AC, because they were good answers when they were posted and a lot of thought went into them.

The short version is: I noticed that the Script WsShell Popup solution stopped working for me in VBA a year ago, and I coded a working API timer callback for the VBA MsgBox function.

Skip straight to the code under the heading VBA code to call a Message Box with a Timeout if you need an answer in a hurry - and I did, I have literally thousands of instances of a self-dismissing 'MsgPopup' substitute for VBA.MsgBox to redact, and the code below fits into a self-contained module.

However, the VBA coders here - myself included - need some explanation as to why perfectly good code no longer seems to work. And if you understand the reasons, you may be able to use the partial workaround for 'Cancel' dialogs, buried in the text.


Grab a coffee, this is a long read...





I noticed that the Script WsShell Popup solution stopped working for me in VBA a year ago - The 'SecondsToWait' timeout was being ignored, and the dialog just hung around like the familiar VBA.MsgBox:

MsgPopup = objWShell.PopUp(Prompt, SecondsToWait, Title, Buttons)

...And I think I know the reason why: you can no longer send a WM_CLOSE or WM_QUIT message to a dialog window from anywhere other than the thread which opened it. Likewise, the User32 DestroyWindow() function will not close a dialog window unless it's called by the thread that opened the dialog.

Someone in Redmond doesn't like the idea of a script running in the background and sending a WM_CLOSE commands to all those essential warnings that halt your work (and, these days, making them go away permanently needs local admin privileges). I can't imagine who would write a script like that, it's a terrible idea!

There are consequences and collateral damage to that decision: WsScript.Popup() objects in the single-threaded VBA environment implement their 'SecondsToWait' timeout using a Timer callback, and that callback sends a WM_CLOSE message, or something like it... Which is ignored in most cases, because it's a call back thread, not owner thread for the dialog.

You might get it to work on a popup with a 'CANCEL' button, and it'll become clear why that is in a minute or two.

I've tried writing a timer callback to WM_CLOSE the popup, and that failed for me, too, in most cases.

I've tried some exotic API callbacks to mess with the VBA.MsgBox and WsShell.Popup window, and I can tell you now that that they didn't work. You can't work with what isn't there: those dialog windows are very simple and most of them don't contain any functionality, at all, except for the responses in the button clicks - Yes, No, OK, Cancel, Abort, Retry, Ignore, and Help.

'Cancel' is an interesting one: it appears that you get a freebie from the primitive Windows API for built-in dialogs when you specify vbOKCancel or vbRetryCancel or vbYesNoCancel - the 'Cancel' function is automatically implemented with a 'close' button in the dialog's Menu bar (you don't get that with the other buttons, but feel free to try it with a dialog containing 'Ignore'), which means that....

WsShell.Popup() dialogs will sometimes respond to the SecondsToWait timeout if they have a 'Cancel' option.

objWShell.PopUp("Test Me", 10, "Dialog Test", vbQuestion + vbOkCancel)

That might be a good enough workaround for someone reading this, if all you wanted was to get WsShell.Popup() functions to respond to the SecondsToWait parameter again.

...This also means that you can send WM_CLOSE messages to the 'Cancel' dialog using the SendMessage() API call on a callback:

SendMessage(hwndDlgBox, WM_CLOSE, ByVal 0&, ByVal 0&)

Strictly speaking, this should only work for the WM_SYSCOMMAND, SC_CLOSE message - the 'close' box in the command bar is a 'system' menu with a special class of commands but, like I said, we're getting freebies from the Windows API.

I got that to work, and I started thinking: If I can only work with what's there, maybe I'd better find out what's actually there...

...And the answer turns out to be obvious: Dialog boxes have their own set of WM_COMMAND message parameters -

' Dialog window message parameters, replicating Enum vbMsgBoxResult: CONST dlgOK As Long = 1 CONST dlgCANCEL As Long = 2 CONST dlgABORT As Long = 3 CONST dlgRETRY As Long = 4 CONST dlgIGNORE As Long = 5 CONST dlgYES As Long = 6 CONST dlgNO As Long = 7

And, as these are the 'user' messages which return the user responses to the caller (that is to say, the calling thread) of the dialog, the dialog box is happy to accept them and close itself.

You can interrogate a dialog window to see if it implements a particular command and, if it does, you can send that command:

If GetDlgItem(hWndMsgBox, vbRetry) <> 0 Then SendMessage hWndMsgBox, WM_COMMAND, vbRetry, 0& Exit For End If

The remaining challenge is to detect a 'Timeout' and intercept the returning Message Box response, and substitute our own value: -1 if we're following the convention established by the WsShell.Popup() function. So our 'msgPopup' wrapper for a Message Box with a timeout needs to do three things:

1. Call our API Timer for the delayed dismissal of the dialog;
2. Open the message Box, passing in the usual parameters;
3. Either: Detect a timeout and substitute the 'timeout' response...
   ...Or return the user response to the dialog, if they responded in time

Elsewhere, we need to declare the API calls for all this, and we absolutely must have Publicly-declared 'TimerProc' function for the Timer API to call. That function has to exist, and it has to run to 'End Function' without errors or breakpoints - any interruption, and the API Timer() will call down the wrath of the operating system.

VBA code to call a Message Box with a Timeout:

MsgPopup = objWShell.PopUp(Prompt, SecondsToWait, Title, Buttons)

And here are the API declarations - note the conditional declarations for VBA7, 64-Bit Windows, and plain-vanilla 32-bit:

objWShell.PopUp("Test Me", 10, "Dialog Test", vbQuestion + vbOkCancel)

A final note: I would welcome suggestions for improvement from experienced MFC C++ developers, as you are going to have a much better grasp of the basic Windows message-passing concepts underlying a 'Dialog' window - I work in an oversimplified language and it is likely that the oversimplifications in my understanding have crossed the line into outright errors in my explanation.

Answer 2

使用答案A. Win32解决方案.这符合要求,并且到目前为止测试非常稳健.

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