VBA MsgBox timer?

Andrew Fergus

Andrew Fergus

MrExcel MVP
Joined
Sep 9, 2004
Messages
5,462
Office Version
  1. 365
  2. 2021
  3. 2016
Platform
  1. Windows
Hello Everyone
Is it possible to have a timer on a VBA message box such that it disappears after a set interval? I have a standard VBA MsgBox informing the user that an action was successful - how can I make the message box disappear (as if Ok was pressed) after 3 seconds? Is this possible? I'm new with VB and am using it in conjuntion with Access 2000.
TIA, Andrew :)
 
Sort by date Sort by votes
I can get the form to close automatically after X seconds, but I can't get it to do either a button click to close the form OR after a certain time period. Seems it's either one or the other...
 
Upvote 0

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
I will settle with the automatic time out exit.
Can you send the participants how you managed to do that ?

Thanx ;)
 
Upvote 0
This is one way to do it. I attached the code to an button click event:

Code: 
Private Sub CommandButton1_Click()
UserForm1.Show
DoEvents
If Application.Wait(Now + TimeValue("0:00:10")) Then Unload UserForm1
End Sub

This will display the userform for 10 seconds. Obviously, change the 10 above to be however many second (minutes, or hours) appropriate for your application.
 
Upvote 0
sous2817 said:
I can get the form to close automatically after X seconds, but I can't get it to do either a button click to close the form OR after a certain time period. Seems it's either one or the other...
Click to expand...

One way :

Code: 
Sub LoadForm()
    Application.OnTime Now + TimeSerial(0, 0, 10), "UnloadForm"
    UserForm1.Show
End Sub

Sub UnloadForm()
    Unload UserForm1
End Sub
 
Upvote 0
Hallo

It's been 2 months ..
Is there a solution to the request to close after msgbox n. second

Code: 
'To display a timed Msgbox use the Msgbox2 routine given below. Note, a demonstration routine can be found at the bottom of this post:

'------------API calls for Msgbox------------------------
'------------MUST BE PLACED IN A STANDARD MODULE----------
Option Explicit

'API calls for Msgbox2. Must be placed in a standard module
Private Declare Function SetTimer Lib "user32" (ByVal Hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal Hwnd As Long, ByVal nIDEvent As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal Hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Any) As Long
Private zsMessageTitle As String, lTimerId As Long


'Purpose     :  Stops the timer routine
'Inputs      :  N/A
'Outputs     :  Returns True if the timer routine was stopped
'Author      :  Andrew Baker
'Date        :  15/10/2000 15:24
'Notes       :  Code must be placed in a module
'Revisions   :

Function EndTimer() As Boolean
    If lTimerId Then
        lTimerId = KillTimer(0&, lTimerId)
        lTimerId = 0
        EndTimer = True
    End If
End Function

'Purpose     :  Starts the continuous calling of a private routine at a specific time interval.
'Inputs      :  lInterval           The interval (in ms) at which to call the routine
'Outputs     :  N/A
'Author      :  Andrew Baker
'Date        :  15/10/2000 15:30
'Notes       :  Code must be placed in a module
'Revisions   :

Sub StartTimer(lInterval As Long)
    If lTimerId Then
        'End Current Timer
        EndTimer
    End If
    lTimerId = SetTimer(0&, 0&, ByVal lInterval, AddressOf TimerRoutine)
End Sub


'Purpose     :  Routine which is called repeatedly by the timer API.
'Inputs      :  Inputs are automatically generated.
'Outputs     :
'Author      :  Andrew Baker
'Date        :  15/10/2000 15:32
'Notes       :
'Revisions   :

Private Sub TimerRoutine(ByVal lHwnd As Long, ByVal lMsg As Long, ByVal lIDEvent As Long, ByVal lTime As Long)
    Const WM_CLOSE = &H10
    Dim lHwndMsgbox As Long

    'Find the Msgbox
    lHwndMsgbox = FindWindow(vbNullString, zsMessageTitle)
    'Close Msgbox
    Call SendMessage(lHwndMsgbox, WM_CLOSE, 0, ByVal 0&)
End Sub



'Purpose     :  Extended version of Msgbox, has extra parameter to set time msgbox is displayed for
'Inputs      :  As per Msgbox
'               [DisplayTime]               The time in MS to display the message.
'Outputs     :  As per Msgbox
'Author      :  Andrew Baker
'Date        :  03/01/2001 13:23
'Notes       :
'Revisions   :

Function Msgbox2(Prompt As String, Buttons As VbMsgBoxStyle, Title As String, Optional DisplayTime As Long) As VbMsgBoxResult
    If DisplayTime > 0 Then
        'Enable the timer
        StartTimer DisplayTime
        zsMessageTitle = Title
    End If
    Msgbox2 = MsgBox(Prompt, Buttons, Title)
    'Stop the timer
    EndTimer
End Function

''Demonstration routine
Sub TestMessage()
    Dim lRetVal As VbMsgBoxResult
    lRetVal = Msgbox2("hello .. the program is fully functional." & vbCrLf & _
    "Per la verifica delle vincite andare indietro col cursore ogni 5° del mese.", vbOKOnly + vbInformation, "AVVISO!!!", 6000)
    Debug.Print lRetVal
End Sub

Also likely to concern.
 
Upvote 0
Did you look at the link I shared?
ISY said:
Hallo

It's been 2 months ..
Is there a solution to the request to close after msgbox n. second

Code: 
'To display a timed Msgbox use the Msgbox2 routine given below. Note, a demonstration routine can be found at the bottom of this post:

'------------API calls for Msgbox------------------------
'------------MUST BE PLACED IN A STANDARD MODULE----------
Option Explicit

'API calls for Msgbox2. Must be placed in a standard module
Private Declare Function SetTimer Lib "user32" (ByVal Hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal Hwnd As Long, ByVal nIDEvent As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal Hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Any) As Long
Private zsMessageTitle As String, lTimerId As Long


'Purpose     :  Stops the timer routine
'Inputs      :  N/A
'Outputs     :  Returns True if the timer routine was stopped
'Author      :  Andrew Baker
'Date        :  15/10/2000 15:24
'Notes       :  Code must be placed in a module
'Revisions   :

Function EndTimer() As Boolean
    If lTimerId Then
        lTimerId = KillTimer(0&, lTimerId)
        lTimerId = 0
        EndTimer = True
    End If
End Function

'Purpose     :  Starts the continuous calling of a private routine at a specific time interval.
'Inputs      :  lInterval           The interval (in ms) at which to call the routine
'Outputs     :  N/A
'Author      :  Andrew Baker
'Date        :  15/10/2000 15:30
'Notes       :  Code must be placed in a module
'Revisions   :

Sub StartTimer(lInterval As Long)
    If lTimerId Then
        'End Current Timer
        EndTimer
    End If
    lTimerId = SetTimer(0&, 0&, ByVal lInterval, AddressOf TimerRoutine)
End Sub


'Purpose     :  Routine which is called repeatedly by the timer API.
'Inputs      :  Inputs are automatically generated.
'Outputs     :
'Author      :  Andrew Baker
'Date        :  15/10/2000 15:32
'Notes       :
'Revisions   :

Private Sub TimerRoutine(ByVal lHwnd As Long, ByVal lMsg As Long, ByVal lIDEvent As Long, ByVal lTime As Long)
    Const WM_CLOSE = &H10
    Dim lHwndMsgbox As Long

    'Find the Msgbox
    lHwndMsgbox = FindWindow(vbNullString, zsMessageTitle)
    'Close Msgbox
    Call SendMessage(lHwndMsgbox, WM_CLOSE, 0, ByVal 0&)
End Sub



'Purpose     :  Extended version of Msgbox, has extra parameter to set time msgbox is displayed for
'Inputs      :  As per Msgbox
'               [DisplayTime]               The time in MS to display the message.
'Outputs     :  As per Msgbox
'Author      :  Andrew Baker
'Date        :  03/01/2001 13:23
'Notes       :
'Revisions   :

Function Msgbox2(Prompt As String, Buttons As VbMsgBoxStyle, Title As String, Optional DisplayTime As Long) As VbMsgBoxResult
    If DisplayTime > 0 Then
        'Enable the timer
        StartTimer DisplayTime
        zsMessageTitle = Title
    End If
    Msgbox2 = MsgBox(Prompt, Buttons, Title)
    'Stop the timer
    EndTimer
End Function

''Demonstration routine
Sub TestMessage()
    Dim lRetVal As VbMsgBoxResult
    lRetVal = Msgbox2("hello .. the program is fully functional." & vbCrLf & _
    "Per la verifica delle vincite andare indietro col cursore ogni 5° del mese.", vbOKOnly + vbInformation, "AVVISO!!!", 6000)
    Debug.Print lRetVal
End Sub

Also likely to concern.
Click to expand...
 
Upvote 0
getting back onto the topic of a Self Closing Message Box:
/
Const Title As String = "Self closing message box"
Const Delay As Byte = 3 'this isn't exactly seconds, any value over 5 will be TOOO long
Const wButtons As Integer = 16 ' Boutons + icon
Dim wsh As Object, msg As String
Set wsh = CreateObject("WScript.Shell")
msg = Space(0) & "Insert your message here." & vbLf & vbLf & "And here if you wish."
wsh.Popup msg, Delay, Title, wButtons
Set wsh = Nothing
/
Sticking with getting off topic of a Self Closing Message Box, if you are intersted in a potentially missed message box, have you thought of using vbspeak? Its a fun way to catch someone off guard and actually pay attention to a file that they may become bored and careless with.
/
Application.Speech.Speak "Action is complete!"
/
or my favorite:
/
Application.Speech.Speak "do not push the button so hard. I have feelings too!"
/

Regards,
-=me=-
 
Upvote 0
It's been more than 3 years. ;)
It's a beautifull Msgbox with timer you / Andrew Baker made. But after trying for a few hours to make it work with vbYesNo, I give up. I can not find the Msg or wParam or lParam to send a vbYes or vbNo with messagesendA (or anything else) to the Msgbox.
Anybody?

ISY said:
Hallo

It's been 2 months ..
Is there a solution to the request to close after msgbox n. second

Code: 
'To display a timed Msgbox use the Msgbox2 routine given below. Note, a demonstration routine can be found at the bottom of this post:

'------------API calls for Msgbox------------------------
'------------MUST BE PLACED IN A STANDARD MODULE----------
Option Explicit

'API calls for Msgbox2. Must be placed in a standard module
Private Declare Function SetTimer Lib "user32" (ByVal Hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal Hwnd As Long, ByVal nIDEvent As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal Hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Any) As Long
Private zsMessageTitle As String, lTimerId As Long


'Purpose     :  Stops the timer routine
'Inputs      :  N/A
'Outputs     :  Returns True if the timer routine was stopped
'Author      :  Andrew Baker
'Date        :  15/10/2000 15:24
'Notes       :  Code must be placed in a module
'Revisions   :

Function EndTimer() As Boolean
    If lTimerId Then
        lTimerId = KillTimer(0&, lTimerId)
        lTimerId = 0
        EndTimer = True
    End If
End Function

'Purpose     :  Starts the continuous calling of a private routine at a specific time interval.
'Inputs      :  lInterval           The interval (in ms) at which to call the routine
'Outputs     :  N/A
'Author      :  Andrew Baker
'Date        :  15/10/2000 15:30
'Notes       :  Code must be placed in a module
'Revisions   :

Sub StartTimer(lInterval As Long)
    If lTimerId Then
        'End Current Timer
        EndTimer
    End If
    lTimerId = SetTimer(0&, 0&, ByVal lInterval, AddressOf TimerRoutine)
End Sub


'Purpose     :  Routine which is called repeatedly by the timer API.
'Inputs      :  Inputs are automatically generated.
'Outputs     :
'Author      :  Andrew Baker
'Date        :  15/10/2000 15:32
'Notes       :
'Revisions   :

Private Sub TimerRoutine(ByVal lHwnd As Long, ByVal lMsg As Long, ByVal lIDEvent As Long, ByVal lTime As Long)
    Const WM_CLOSE = &H10
    Dim lHwndMsgbox As Long

    'Find the Msgbox
    lHwndMsgbox = FindWindow(vbNullString, zsMessageTitle)
    'Close Msgbox
    Call SendMessage(lHwndMsgbox, WM_CLOSE, 0, ByVal 0&)
End Sub



'Purpose     :  Extended version of Msgbox, has extra parameter to set time msgbox is displayed for
'Inputs      :  As per Msgbox
'               [DisplayTime]               The time in MS to display the message.
'Outputs     :  As per Msgbox
'Author      :  Andrew Baker
'Date        :  03/01/2001 13:23
'Notes       :
'Revisions   :

Function Msgbox2(Prompt As String, Buttons As VbMsgBoxStyle, Title As String, Optional DisplayTime As Long) As VbMsgBoxResult
    If DisplayTime > 0 Then
        'Enable the timer
        StartTimer DisplayTime
        zsMessageTitle = Title
    End If
    Msgbox2 = MsgBox(Prompt, Buttons, Title)
    'Stop the timer
    EndTimer
End Function

''Demonstration routine
Sub TestMessage()
    Dim lRetVal As VbMsgBoxResult
    lRetVal = Msgbox2("hello .. the program is fully functional." & vbCrLf & _
    "Per la verifica delle vincite andare indietro col cursore ogni 5° del mese.", vbOKOnly + vbInformation, "AVVISO!!!", 6000)
    Debug.Print lRetVal
End Sub

Also likely to concern.
Click to expand...
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question
Find all or certain formulas in a Workbook
Replies
1
Views
366
johnnyL
J
B
  • Question
Event code to give message box and change color of auto-shape
Replies
4
Views
138
bh24524
B
D
  • Solved
VBA Excel OpenDialogBox then Transfer the information to cell
Replies
5
Views
180
Daniza Morla
D
D
  • Solved
Using ActiveCell to display cell value in MsgBox
Replies
8
Views
992
Tetra201
Tetra201
C
  • Question
Best coding practices in VBA (specifically, code structure, readability, compactness, and the TEBV & TBTO rules)
Replies
1
Views
4K
Marc L
Marc L

Forum statistics

Threads
1,214,643
Messages
6,120,707
Members
448,981
Latest member
recon11bucks

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top