Solved Timed Message Box

kengooch

kengooch

Member
Local time
Yesterday, 17:50
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.
 
you can also used Enhanced Messagebox:

Improved, Enhanced Message Box for MS Access

This is an improvement, better yet a replacement for the VBA msgbox. It's an extended version of Renaud Bompuis project and now offers AutoClose, Custom Default Button, Color and Hovereffect of buttons as well as a Code-Wizard besides other improvements. It works on MS Access...
datenbank-projekt.de datenbank-projekt.de

there is also another one in the Sample database forum:

Better Msgbox alternative

before giving this out to the OP, might as well put it here for everyone. the bulk of the code is not mine, just added some good feature.
www.access-programmers.co.uk
 
sonic8 said:
What seems to be the problem? The code you posted should work in Access without any changes.
Click to expand...
i have win11 and a2021, and i can confirm it no longer time-out.
as i google i saw same problem with no solution.
 
win11 and office 365.
For me the timeout doesn't work neither in Access nor in Excel.
 
kengooch said:
Regretfully, it doesn't seem to
Click to expand...
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
 
arnelgp said:
you can also used Enhanced Messagebox:

Improved, Enhanced Message Box for MS Access

This is an improvement, better yet a replacement for the VBA msgbox. It's an extended version of Renaud Bompuis project and now offers AutoClose, Custom Default Button, Color and Hovereffect of buttons as well as a Code-Wizard besides other improvements. It works on MS Access...
datenbank-projekt.de datenbank-projekt.de

there is also another one in the Sample database forum:

Better Msgbox alternative

before giving this out to the OP, might as well put it here for everyone. the bulk of the code is not mine, just added some good feature.
www.access-programmers.co.uk
Click to expand...
WOWZA!!! That's amazing! But i didn't see anything about
sonic8 said:
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
Click to expand...
It opens the MsgBox and leaves it sitting on the screen until you click OK
 
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.
 
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
 
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
 
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!
 
sonic8 said:
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.
Click to expand...
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
 
You could also try the customised message form with timer in my Attention Seeking Database example app:
www.isladogs.co.uk

Attention Seeking Database

This shows many different ways of getting users' attention including customised message boxes, flashing/scrolling/balloon tooltip text, form animation, transparency and fade, dim/blur/remove background
www.isladogs.co.uk www.isladogs.co.uk
 
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:
1.png

2.png

3.png
 
You must log in or register to reply here.

Similar threads

L
Solved Run Dos Command in VBA
Replies
19
Views
1,029
GPGeorge
GPGeorge
S
Solved Timing or other issue when closing Excel from Access
Replies
13
Views
1,207
sxschech
S
N
Solved How to remove this error "the execution this software stopped due to run time" error in MS Access VBA
Replies
11
Views
1,284
Minty
Minty
C
Checking if records exist
Replies
9
Views
1,348
cheekybuddha
cheekybuddha
N
Solved How to send multiple attachment with CDO Gmail in MS Access VBA
Replies
11
Views
1,306
nector
N

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom