Solved Timed Message Box

[kengooch]

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

     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.

 

[moke123]

TaskDialog has a timer feature with a progress bar too.

https://www.vbforums.com/showthread...te-class-implementation-of-Vista-Task-Dialogs

 

[arnelgp]

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

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]

I can not seem to find a way to do this in Access.

What seems to be the problem? The code you posted should work in Access without any changes.

 

[arnelgp]

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]

win11 and office 365.
For me the timeout doesn't work neither in Access nor in Excel.

 

[kengooch]

What seems to be the problem? The code you posted should work in Access without any changes.

Regretfully, it doesn't seem to

 

[sonic8]

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.

CreateObject("WScript.Shell").PopUp "Test Message", 10, "Test Title", vbMsgBoxSetForeground

 

[kengooch]

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

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

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.

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]

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]

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:

#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:

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]

actually StrPtr() is unnecessary. Also Result will also be 1 (on timeout) when you dont specify any button (default is vbOKOnly) or specify vbOKOnly.

'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]

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]

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]

heres an example using task dialog

 

[isladogs]

You could also try the customised message form with timer in my Attention Seeking Database example app:

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

 

[kengooch]

heres an example using task dialog

This is beyond amazing! thanks!!

 

[arnelgp]

this will also do with Unicode:

'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

 

[arnelgp]

 

[moke123]

with a contact email and phone extension.

You can also include a hyperlink in the task dialog for an email address.

All the features are described here . . . Task Dialog