Solved Timed Message Box (1 Viewer)

kengooch

Member
Local time
Today, 03:00
Joined
Feb 29, 2012
Messages
137
I often use a timed MsgBox to advise user of events that happen during code execution and always to let them know who wrote the Database or Excel App with a contact email and phone extension. The most common vba code I use is
Code:
     CreateObject("WScript.Shell").Popup vMsg, vSec, vTitle, vbMsgBoxSetForeground
Obviouslly I assign the variables vMsg, vSec, etc and pass those values when I call the msgbox.

I can not seem to find a way to do this in Access. I have tried many different methods, but the Msgbox just opens and sits there until you click OK.
If any one knows a way to create a time MsgBox in Access I would love to know how.
 

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 18:00
Joined
May 7, 2009
Messages
19,169
you can also used Enhanced Messagebox:

there is also another one in the Sample database forum:
 

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 18:00
Joined
May 7, 2009
Messages
19,169
What seems to be the problem? The code you posted should work in Access without any changes.
i have win11 and a2021, and i can confirm it no longer time-out.
as i google i saw same problem with no solution.
 

KitaYama

Well-known member
Local time
Today, 19:00
Joined
Jan 6, 2022
Messages
1,489
win11 and office 365.
For me the timeout doesn't work neither in Access nor in Excel.
 

sonic8

AWF VIP
Local time
Today, 11:00
Joined
Oct 27, 2015
Messages
998
Regretfully, it doesn't seem to
What does it do instead exactly? - Well, ok, you said that.
Can you show the full code including the variable assignments, or even better, try to run the core statement without variables.
Code:
CreateObject("WScript.Shell").PopUp "Test Message", 10, "Test Title", vbMsgBoxSetForeground
 

kengooch

Member
Local time
Today, 03:00
Joined
Feb 29, 2012
Messages
137
you can also used Enhanced Messagebox:

there is also another one in the Sample database forum:
WOWZA!!! That's amazing! But i didn't see anything about
What does it do instead exactly? - Well, ok, you said that.
Can you show the full code including the variable assignments, or even better, try to run the core statement without variables.
Code:
CreateObject("WScript.Shell").PopUp "Test Message", 10, "Test Title", vbMsgBoxSetForeground
It opens the MsgBox and leaves it sitting on the screen until you click OK
 

sonic8

AWF VIP
Local time
Today, 11:00
Joined
Oct 27, 2015
Messages
998
As multiple people see the same problem on Windows 11, it might be a problem that happens there.
I can't test on Win11. It basically works for me on Win 8.1 and 10 but the actual timeout takes 3-5 times longer than the argument supplied.
 

D_Walla

Member
Local time
Today, 10:00
Joined
Aug 1, 2021
Messages
32
If you're not averse to using an API, I just tested the following so fingers-crossed, it should work. It uses the API - MessageBoxTimeoutW (unicode compatible), and I have included both 32- and 64-bit declarations:

Code:
#If Win64 Then
    Private Declare PtrSafe Function MessageBoxTimeoutW Lib "user32.dll" (ByVal hWnd As LongPtr, ByVal lpText As LongPtr, ByVal lpCaption As LongPtr, ByVal uType As Long, ByVal wLanguageID As Long, ByVal lngMilliseconds As Long) As Long
#Else
    Private Declare Function MessageBoxTimeoutW Lib "user32.dll" (ByVal hwnd As Long, ByVal lpText As Long, ByVal lpCaption As Long, ByVal uType As Long, ByVal wLanguageID As Long, ByVal lngMilliseconds As Long) As Long
#End If

Function TimedMsgBox(Prompt As String, Optional Buttons As VbMsgBoxStyle = vbOKOnly, Optional Title As String = "Important Notice", Optional Timeout As Long = 5000) As VbMsgBoxResult
    TimedMsgBox = MessageBoxTimeoutW(Application.hWndAccessApp, StrPtr(Prompt), StrPtr(Title), Buttons, 0, Timeout)
End Function

And here is some test code, which calls a message box that will timeout after 3 seconds. If it does timeout, the API will return code 32000, as set out below:

Code:
Sub Test()
    Dim Result As VbMsgBoxResult
    Result = TimedMsgBox("This uses the unicode-compatible MessageBoxTimeoutW API", vbExclamation Or vbOKCancel, "Gone in 3 seconds...!", 3000)
    Select Case Result
        Case vbOK     ' 1
            Debug.Print "User pressed OK"
        Case vbCancel ' 2
            Debug.Print "User pressed Cancel"
        Case 32000
            Debug.Print "No response - MessageBox timed out"
    End Select
End Sub
 

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 18:00
Joined
May 7, 2009
Messages
19,169
actually StrPtr() is unnecessary. Also Result will also be 1 (on timeout) when you dont specify any button (default is vbOKOnly) or specify vbOKOnly.
Code:
'https://www.extendoffice.com/documents/excel/3836-excel-message-box-timer-timeout.html
#If VBA7 Then
Private Declare PtrSafe Function CustomTimeOffMsgBox Lib "user32" Alias "MessageBoxTimeoutA" ( _
            ByVal xHwnd As LongPtr, _
            ByVal xText As String, _
            ByVal xCaption As String, _
            ByVal xMsgBoxStyle As VbMsgBoxStyle, _
            ByVal xwlange As Long, _
            ByVal xTimeOut As Long) _
    As Long
#Else
Private Declare Function CustomTimeOffMsgBox Lib "user32" Alias "MessageBoxTimeoutA" ( _
            ByVal xHwnd As Long, _
            ByVal xText As String, _
            ByVal xCaption As String, _
            ByVal xMsgBoxStyle As VbMsgBoxStyle, _
            ByVal xwlange As Long, _
            ByVal xTimeOut As Long) _
    As Long
#End If

Private Sub Test()
Dim result As Long
result = CustomTimeOffMsgBox(0, "Moved successfully. This message box will be closed after 4 seconds", "Kutools for Excel", vbInformation, 0, 4000)
Debug.Print result
End Sub
 

D_Walla

Member
Local time
Today, 10:00
Joined
Aug 1, 2021
Messages
32
You're absolutely right about vbOKOnly - Thank you for pointing that out. I should've mentioned it, but I just wanted to demonstrate what the return value would otherwise be in case it was helpful.

As to StrPtr - it is necessary for MessageBoxTimeoutW, which is a unicode-enabled API. You've opted for MessageBoxTimeoutA, the ANSI equivalent, which is incapable of displaying unicode characters. I tend to go for unicode by default, though I appreciate that the StrPtr requirement can be annoying!
 

kengooch

Member
Local time
Today, 03:00
Joined
Feb 29, 2012
Messages
137
As multiple people see the same problem on Windows 11, it might be a problem that happens there.
I can't test on Win11. It basically works for me on Win 8.1 and 10 but the actual timeout takes 3-5 times longer than the argument supplied.
Yes I have observed this when using it with Excel, I attribute it to the server delay here at the VA Medical Center... We have a lot of security hoops and the servers are all remote
 

moke123

AWF VIP
Local time
Today, 06:00
Joined
Jan 11, 2013
Messages
3,849
heres an example using task dialog
 

Attachments

  • SelfClosingMessageBox.accdb
    1.1 MB · Views: 320

isladogs

MVP / VIP
Local time
Today, 10:00
Joined
Jan 14, 2017
Messages
18,186
You could also try the customised message form with timer in my Attention Seeking Database example app:
 

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 18:00
Joined
May 7, 2009
Messages
19,169
this will also do with Unicode:

Code:
'arnelgp
#If VBA7 Then
    Private Declare PtrSafe Function MessageBoxTimeoutW Lib "user32.dll" (ByVal hWnd As LongPtr, ByVal lpText As String, ByVal lpCaption As String, ByVal uType As Long, ByVal wLanguageID As Long, ByVal lngMilliseconds As Long) As Long
#Else
    Private Declare Function MessageBoxTimeoutW Lib "user32.dll" (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
#End If

Function TimedMsgBox(Prompt As String, Optional Buttons As VbMsgBoxStyle = vbOKOnly, Optional Title As String = "Important Notice", Optional Timeout As Long = 5000) As VbMsgBoxResult
    TimedMsgBox = MessageBoxTimeoutW(0&, StrConv(Prompt, vbUnicode), StrConv(Title, vbUnicode), Buttons, 0, Timeout)
End Function
 
Last edited:

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 18:00
Joined
May 7, 2009
Messages
19,169
1.png

2.png

3.png
 

Users who are viewing this thread

Top Bottom