Search code examples
vbams-access

How to open a timed Message Box in MS ACCES without creating additional window


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?


Solution

  • 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
    

    Update 2019-04-05

    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