On pressing a Save
button on a form
, I would like to run a Timed Message Box that closes automatically after 1 second. The default MsgBox
command does not disappear until user presses OK
or Exit
.
So far, I have a solution from online search:
Public Sub Timed_Box (dur AS Long)
Dim WSH AS IWshRuntimeLibrary.WshShell
Dim Res AS Long
Set WSH = IWshRuntimeLibrary.WshShell
Res = WSH.PopUp(Text:="Record Updated", secondstowait:=dur, _
Title:="Update", Type:=vbOKOnly)
End Sub
It works fine. However, the problem is that it creates a temporary Window on desktop Taskbar for the duration which is quite annoying for a user to see. Is there anyway, I can hide this window from appearing on taskbar while still display message similar to MsgBox
?
I wrote an additional answer instead of just a comment, because it seems to be too important to the requested context.
Lone wrote regarding MatteoNNZ's answer:
Thanks for sharing, the result is no different from what I am achieving with my existing code. Your code also produced a Temporary Window on taskbar.
But it's just a small step away from your needs!
Just provide the handle of your Microsoft Access Window (Application.hWndAccessApp
) to the Api to let the resulting message box be 'visually bound' to Microsoft Access:
MsgBoxTimeout Application.hWndAccessApp, "This message box will be closed after 1 second ", "Automatically closing MsgBox", vbInformation, 0, 1000
Here is a wrapper for the MessageBoxTimeout to simplify the calling.
The order of the parameters and their default values follow the original MsgBox
function.
It uses the original API function namens to free this name for the user defined procedure.
I added an enumeration for the timeout return value 32000
.
You should take care to add proper error handling.
#If VBA7 Then
Private Declare PtrSafe Function MessageBoxTimeoutA Lib "user32" (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
Public Enum VbMsgBoxTimeoutResult
Timeout = 32000
End Enum
'// If parameter msgTimeoutMilliseconds < 1 then the message box will not close by itself.
'// There is one additional return value to the values of VbMsgBoxResult:
'// If the message box timed out it returns 32000 (VbMsgBoxTimeoutResult.Timeout).
Public Function MsgBoxTimeout(ByVal msgText As String, Optional ByVal msgButtons As VbMsgBoxStyle = vbOKOnly, Optional ByVal msgTitle As String = vbNullString, Optional ByVal msgTimeoutMilliseconds As Long = 0) As VbMsgBoxResult
MsgBoxTimeout = MessageBoxTimeoutA(Application.hWndAccessApp, msgText, msgTitle, msgButtons, 0, msgTimeoutMilliseconds)
End Function
An usage example:
Select Case MsgBoxTimeout("Foo", vbYesNo + vbQuestion, "Bar", 5000)
Case VbMsgBoxTimeoutResult.Timeout
Debug.Print "MessageBox timed out."
Case vbYes
Debug.Print "User selected 'Yes'."
Case Else
Debug.Print "User selected 'No'."
End Select