How to Close InfoBox.Popup on Timer Expiration?

Question

I cobbled this test procedure together in Outlook 2013 from other posts.

It should display a popup box, and then close after 3 seconds.

It never closes.

Sub MessageBoxTimer()
    Dim AckTime As Integer, InfoBox As Object
    Set InfoBox = CreateObject("WScript.Shell")

    AckTime = 3
    Select Case InfoBox.Popup("Click OK (this window closes automatically after 3 seconds).", _
    AckTime, "This is your Message Box", 0)
    Case 1, -1
        Exit Sub
    End Select
End Sub

Answer 1

Some research suggests that this may be a bug in some MS Office applications. I'm basing this on the fact that this and this don't seem to say anything which suggests you're using the command in the wrong way, and this shows that other users have managed to get precisely this code to work.

I tested this on my Windows PC running Excel with Office 365 and have had the same issue as you - the message box is displayed, but not closed. I found a suggested workaround here, and the discussion on that page may be of some interest to you (particularly one user's description of trying to submit a bug report to Microsoft about VBA). The solution, proposed by a user called ウィンドウズスクリプトプログラマ, is to make a call through to the native user32.dll by declaring an external function - this page has some examples of how to call C dlls with VBA.The MessageBoxTimeout function is said to be undocumented by Microsoft, but you can find out a lot about it here.

The other option, which worked for me, is run a vbscript call to Shell.Popup with mshta.exe:

Function Test()

    Dim Shell
    Set Shell = CreateObject("WScript.Shell")
    Shell.Run "mshta.exe vbscript:close(CreateObject(""WScript.shell"").Popup(""Test"",3,""Message""))"

End Function

To get this to work with more complex messages, you may need to escape some characters. There is another SO question here which shows other uses for mshta's ability to execute vbscript in a shell/ console.

Finally, as was suggested by one user, you could simply create a custom user form with a doevents loop that counts down and then closes itself.

Answer 2

The WScript.Shell .Popup seems to be hit or miss in Office VBA.

If you are looking for a MsgBox that works in Office VBA and supports a timeout, I posted another method that uses a Windows API call. It supports timeout, carriage returns, and return values. You can find the code at this link. I did not think it was proper etiquette to post it again here.

Note that the mshta method mentioned by @Orphid does not support carriage returns and always shows the message on the primary monitor.

Answer 3

Yes, I can confirm that result: the 'Timeout' on the WsShell.Popup function is no longer working in Office.

It took me a while to notice, because popup dialogs with a 'cancel' button seem to be affected less. So this might be a usable workaround for you:

Dim msg AS String
Dim Title as String

msg ="Click 'Ok' or 'Cancel' (this window closes automatically after 3 seconds)."
Title = Application.name & ": Message Box test"

Select Case InfoBox.Popup(msg, AckTime, Title, vbQuestion + vbOkCancel)

If that doesn't work, you're going to need a much longer explanation: reimplementing the 'Timeout' using an API Timer Callback. As the author of that answer, I should warn you that this is using a sledgehammer to crack a nut after attempting the task with a prolonged naval bombardment.

Answer 4

I have tried the following code to control VBA msg box auto closer after 40 sec. You can try also it. It will work for you.

 'The first part
#If Win64 Then '64?
    Private Declare PtrSafe Function MsgBoxTimeout _
        Lib "user32" _
        Alias "MessageBoxTimeoutA" ( _
            ByVal hwnd As LongPtr, _
            ByVal lpText As String, _
            ByVal lpCaption As String, _
            ByVal wType As VbMsgBoxStyle, _
            ByVal wlange As Long, _
            ByVal dwTimeout As Long) _
    As Long
#Else
    Private Declare Function MsgBoxTimeout _
        Lib "user32" _
        Alias "MessageBoxTimeoutA" ( _
            ByVal hwnd As Long, _
            ByVal lpText As String, _
            ByVal lpCaption As String, _
            ByVal wType As VbMsgBoxStyle, _
            ByVal wlange As Long, _
            ByVal dwTimeout As Long) _
    As Long
#End If
'The second part
Sub btnMsgbox(message As String)
    Call MsgBoxTimeout(0, message, "", vbInformation, 0, 40000)
End Sub