Clicking the OK button on a MessageBox if user doesn't do it

[jmsrickland]

I display a message box with only an OK button. If a certain amount of time goes by and the user hasn't clicked it how can the program do it.

[ColinE66]

Make your own message box (from a form) and incorporate a timer into it that will close the form?

[SamOscarBrown]

I use this function...I put it in a module so it is project wide:

Option Explicit

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
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 Const WM_CLOSE      As Long = 16
Private CurMBTitle          As String
Public Function TimedMsgBox(Prompt As String, Optional ByVal TimeOut As Long = 0, Optional Icon As VbMsgBoxStyle = vbOKOnly, Optional Title As String = vbNullString)
  Dim TimerId   As Long
     CurMBTitle = Title
       If TimeOut = 0 Then
        TimeOut = 5 * 1000
        Else
            TimeOut = TimeOut * 1000
    End If
      TimerId = SetTimer(0, 0, TimeOut, AddressOf TimeOutMB)
    TimedMsgBox = MsgBox(Prompt, Icon, CurMBTitle)
    TimedMsgBox = 0
    KillTimer 0, TimerId
End Function

I call it like this:

TimedMsgBox "Done--This Message will disappear in 3 seconds.", _
                 3, _
                  64, _
                 "MSG BOX TITLE"

[Bonnie West]

One-liner based on the Popup method of the WshShell object.

CreateObject("WScript.Shell").Popup "Don't click me!", 5, "Auto-OK MsgBox", vbOKOnly Or vbInformation

[SamOscarBrown]

Jeez!!! Thanks, Bonnie...the more I hang out here, the more I learn....!

[jmsrickland]

One-liner based on the Popup method of the WshShell object.

CreateObject("WScript.Shell").Popup "Don't click me!", 5, "Auto-OK MsgBox", vbOKOnly Or vbInformation

That's really cool. The only problem I see is that it isn't modal but even at that it perfect for what I need it for.

What is the time interval in relations to the 5

[Bonnie West]

The Popup messagebox isn't "owned" by VB which is why it's not modal to the Form. I guess that's the drawback to that one-liner. If you require a modal MsgBox, I'm pretty sure Sam's code will be just perfect.

[jmsrickland]

@Sam

AddressOf TimeOutMB

Did you forget something?

[jmsrickland]

Although you're one liner is great for my purpose one needs to be careful when using it.

For example:

When displayed and user puts focus on another object, like a textbox, the message box goes behind the Form and will remain static (it appears to loose it's timer) until user either moves form out of the way and clicks on OK or user puts the focus on another application.

[Max187Boucher]

I agree with ColinE66 (post #2) using a form to create whatever you desire to do with your messagebox. Also you create a public/private function call it MessageBox(TextCaption As String, Argument2, Argument3).

[SamOscarBrown]

Hey Max, what was wrong with my post (#3)? I've been using that for quite some time. Sometimes global in module, sometimes only in a form if its a one-form app. Works fine.

[Max187Boucher]

Nothing wrong with your code sam, I think it's great.
I like to create my own usercontrol/form when something like that is needed.

Your code does not require extra forms or usercontrols, which is also a plus.

[jmsrickland]

Well it's only great if it works, which it doesn't

[SamOscarBrown]

Thx....and I understand. But I DO like Bonnie;s one-liner. (Will have to check out what jms said about it losing it's timer.......)

[jmsrickland]

Sam, are you going to fix your code or not?

[Max187Boucher]

Jmsrickland try this, it might not be perfect but it's a start.

[Doogle]

Although you're one liner is great for my purpose one needs to be careful when using it.

For example:

When displayed and user puts focus on another object, like a textbox, the message box goes behind the Form and will remain static (it appears to loose it's timer) until user either moves form out of the way and clicks on OK or user puts the focus on another application.

You can make it system modal: (although under some circumstances it still appears to 'lose' the timer)

Dim wShell As Object
Dim lngRet As Long
Set wShell = CreateObject("WScript.Shell")
lngRet = wShell.Popup("Don't click me!", 5, "Auto-OK MsgBox", vbOKOnly Or vbInformation Or &H1000)

EDIT: I guess with a bit of jiggery-pokery you could 'capture' the mouse such that it couldn't move out of the popup window - but then again, that'd probably irritate the end user

[Bonnie West]

@ Doogle

I tried your modification but it didn't make the MsgBox modal to my Form.

Anyway, I decided to use APIs similar to Sam's post so that the MsgBox call isn't altered in any way. Here is a more complicated but reliable MsgBox auto-closing code:

'In a BAS module
Option Explicit

Private Const MAX_CLASS_NAME As Long = 256
Private Const HCBT_ACTIVATE  As Long = 5
Private Const WH_CBT         As Long = 5

Private Declare Function CallNextHookEx Lib "user32.dll" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function EndDialog Lib "user32.dll" (ByVal hDlg As Long, ByVal nResult As Long) As Long
Private Declare Function GetClassNameW Lib "user32.dll" (ByVal hWnd As Long, ByVal lpClassName As Long, ByVal nMaxCount As Long) As Long
Private Declare Function KillTimer Lib "user32.dll" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
Private Declare Function SetTimer Lib "user32.dll" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, Optional ByVal lpTimerFunc As Long) As Long
Private Declare Function SetWindowsHookExW Lib "user32.dll" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hMod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function SysReAllocStringLen Lib "oleaut32.dll" (ByVal pBSTR As Long, Optional ByVal pszStrPtr As Long, Optional ByVal Length As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32.dll" (ByVal hHook As Long) As Long

Private m_hHook         As Long
Private m_MilSecsToWait As Long
Private m_DefaultRetVal As VbMsgBoxResult

Public Function AutoCloseMsgBox(ByVal SecondsToWait As Long, Optional ByVal DefaultRetVal As VbMsgBoxResult = vbOK) As Boolean
    m_MilSecsToWait = SecondsToWait * 1000& 'Should be in milliseconds
    m_DefaultRetVal = DefaultRetVal
    m_hHook = SetWindowsHookExW(WH_CBT, AddressOf CBTProc, 0&, App.ThreadID)
    AutoCloseMsgBox = m_hHook <> 0&:    Debug.Assert AutoCloseMsgBox
End Function

Private Function GetClassName(ByVal hWnd As Long) As String
    SysReAllocStringLen VarPtr(GetClassName), , MAX_CLASS_NAME
    SysReAllocStringLen VarPtr(GetClassName), StrPtr(GetClassName), _
    GetClassNameW(hWnd, StrPtr(GetClassName), MAX_CLASS_NAME + 1&)
End Function

Private Function CBTProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Select Case nCode
        Case HCBT_ACTIVATE
            If GetClassName(wParam) = "#32770" Then 'The classname of a dialog box
                CBTProc = SetTimer(wParam, lParam, m_MilSecsToWait, AddressOf TimerProc):   Debug.Assert CBTProc
                CBTProc = UnhookWindowsHookEx(m_hHook):                                     Debug.Assert CBTProc
            End If
    End Select
    CBTProc = CallNextHookEx(0&, nCode, wParam, lParam)
End Function

Private Sub TimerProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)
    uMsg = KillTimer(hWnd, idEvent):            Debug.Assert uMsg
    uMsg = EndDialog(hWnd, m_DefaultRetVal):    Debug.Assert uMsg
End Sub

Private Sub Form_Activate()         'Sample usage
    AutoCloseMsgBox 5&, vbOK        'Call it just before showing the MsgBox
    Debug.Print "MsgBox = " & MsgBox("Don't click me!", vbInformation, "Auto-Close MsgBox")
End Sub

[SamOscarBrown]

Sam, are you going to fix your code or not?

There is no fixing necessary....if you MUST know what the address of TimeOutMB is, put a print statement in there...

The code works just fine...have you even tried it?

[jmsrickland]

@Sam

Yes I tried your code but it fails on that statement. I get Compile Error: Expected Sub, Function, or Property. Sorry, Sam, I'm only stating what's happening. TimeOutMB does not exist in the code other than where you put it as Address of TimeOutMB. I don't understand what you mean by put a print statement there.

[jmsrickland]

EDIT: Ignore this code. You don't need two apps as Bonnie explained it in post #25


Here's a way I figured out. Probably silly but.......

Use two applications

App 1 is the application with the MsgBox

App 2 is the application with the timer control and the code to find the MsgBox Window/Button and click on it

Code for App 1

Private Sub Command1_Click()
 Shell Chr(34) & App.Path & "\ClickMBButton.exe" & Chr(34), vbNormalFocus
 MsgBox "Another App will click my button", vbOKOnly, "Test MsgBox"
 Caption = "MsgBox OK Button Clinked"
End Sub

Code for App 2 (which I called ClickMBButton)

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
 (ByVal hwnd As Long, _
  ByVal wMsg As Long, _
  ByVal wParam As Long, _
  lParam As Any) As Long

Private Const BM_CLICK = &HF5
Private Const WM_SETFOCUS = &H7

Private Sub Form_Load()
 Timer1.Enabled = True
End Sub

Private Sub Timer1_Timer()
 Timer1.Enabled = False

 MsgBoxHwnd = FindWindow(vbNullString, "Test MsgBox")
    
 If MsgBoxHwnd Then
   EnumChildWindows MsgBoxHwnd, AddressOf EnumChildProc, &H0
 End If
 
 SetForegroundWindow MsgBoxButtonHwnd
 SendMessage MsgBoxButtonHwnd, WM_SETFOCUS, 0, 0
 SendMessage MsgBoxButtonHwnd, BM_CLICK, 0, 0
 Unload Me
End Sub

Module Code for App 2

Public Declare Function EnumChildWindows Lib "user32" _
  (ByVal hWndParent As Long, _
   ByVal lpEnumFunc As Long, _
   ByVal lParam As Long) As Long
   
Public Declare Function FindWindow Lib "user32" _
    Alias "FindWindowA" (ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long

Public Declare Function GetWindowTextLength Lib "user32" _
    Alias "GetWindowTextLengthA" _
   (ByVal hwnd As Long) As Long
    
Public Declare Function GetWindowText Lib "user32" _
    Alias "GetWindowTextA" _
   (ByVal hwnd As Long, _
    ByVal lpString As String, _
    ByVal cch As Long) As Long
    
Public Declare Function GetClassName Lib "user32" _
    Alias "GetClassNameA" _
   (ByVal hwnd As Long, _
    ByVal lpClassName As String, _
    ByVal nMaxCount As Long) As Long
    
Public MsgBoxHwnd As Long
Public MsgBoxButtonHwnd As Long

Public Function TrimNull(startstr As String) As String
 Dim pos As Integer

 pos = InStr(startstr, Chr$(0))
  
 If pos Then
   TrimNull = Left$(startstr, pos - 1)
   Exit Function
 End If

 TrimNull = startstr
End Function

Public Function GetWindowIdentification(ByVal hwnd As Long, _
 sIDType As String, sClass As String) As String

 Dim nSize As Long
 Dim sTitle As String
  
 nSize = GetWindowTextLength(hwnd)
   
 'if the return is 0, there is no title
 If nSize > 0 Then
   sTitle = Space$(nSize + 1)
   Call GetWindowText(hwnd, sTitle, nSize + 1)
   sIDType = "title"
   sClass = Space$(64)
   Call GetClassName(hwnd, sClass, 64)
 Else
   'no title, so get the class name instead
   sTitle = Space$(64)
   Call GetClassName(hwnd, sTitle, 64)
   sClass = sTitle
   sIDType = "class"
 End If
   
 GetWindowIdentification = TrimNull(sTitle)
End Function

Public Function EnumChildProc(ByVal hwnd As Long, ByVal lParam As Long) As Long
 Dim sTitle As String
 Dim sClass As String
 Dim sIDType As String
   
 '
 ' get the window title/class name
 '
 sTitle = GetWindowIdentification(hwnd, sIDType, sClass)
   
 If InStr(sTitle, "OK") <> 0 Then
   MsgBoxButtonHwnd = hwnd
 End If
 
 EnumChildProc = 1
End Function

[Max187Boucher]

looks like alot of code for a simple thing!
Have you tried my code?

[jmsrickland]

It is a lot of code. That's why I said it probably silly. I was just playing around out of curiosity. It works.

Yes, I tried your code. I like it. Thanks, Max. Nice job

[SamOscarBrown]

@Sam

Yes I tried your code but it fails on that statement. I get Compile Error: Expected Sub, Function, or Property. Sorry, Sam, I'm only stating what's happening. TimeOutMB does not exist in the code other than where you put it as Address of TimeOutMB. I don't understand what you mean by put a print statement there.

Lo siento, lo siento, lo siento....I failed to copy a function inside the module......mea culpa
Add this to that code above:

Private Sub TimeOutMB(hwnd As Long, uMsg As Long, idEvent As Long, dwTime As Long)

    SendMessage FindWindow(vbNullString, CurMBTitle), WM_CLOSE, 0&, 0&

End Sub

[Bonnie West]

There's no need to have a separate App, just add a Timer to the Form and enable it before showing the MsgBox. Of course, VB's Timer control is disabled by the MsgBox in the IDE but runs fine when compiled. That is why my and Sam's code uses SetTimer instead.

[jmsrickland]

Oh, cr_p! I only tested it in the IDE and it didn't work. That's why I made two apps. Yeah, now that I compiled it to EXE it does work.


OK, forget about that stupid post #21

[jmsrickland]

Lo siento, lo siento, lo siento....I failed to copy a function inside the module......mea culpa
Add this to that code above:

Private Sub TimeOutMB(hwnd As Long, uMsg As Long, idEvent As Long, dwTime As Long)

    SendMessage FindWindow(vbNullString, CurMBTitle), WM_CLOSE, 0&, 0&

End Sub

OK, now it's missing SetTimer

TimerId = SetTimer(0, 0, TimeOut, AddressOf TimeOutMB)

[SamOscarBrown]

?
Oh well, to precluded any copy-paste....attached is the module (complete)

And, like I said, add this to a project and call it with something in the same format as my orig code....added no timer controls, references or components.

If this doesn't work for you....I am sorry for haven take so much of your time.....:-(

[jmsrickland]

?
Oh well, to precluded any copy-paste....attached is the module (complete)

And, like I said, add this to a project and call it with something in the same format as my orig code....added no timer controls, references or components.

If this doesn't work for you....I am sorry for haven take so much of your time.....:-(

Perfect!

[ColinE66]

LOL. One modal form. One label. One timer. Job done...

[Max187Boucher]

LOL. One modal form. One label. One timer. Job done...

And one button!

[ColinE66]

Nah. That'd be bloat-ware...

[jmsrickland]

One-liner based on the Popup method of the WshShell object.

CreateObject("WScript.Shell").Popup "Don't click me!", 5, "Auto-OK MsgBox", vbOKOnly Or vbInformation

Problem: When I added a Statusbar control to the Form the message box no longer works; it stays static and the button must be clicked to close it

[Bonnie West]

Problem: When I added a Statusbar control to the Form the message box no longer works; it stays static and the button must be clicked to close it

Well, it looks like the WScript MsgBox isn't very compatible with VB6 after all. I don't know if that can be fixed. I thought you decided to go with Sam's code?

[jmsrickland]

No, I liked Sam's code but I used yours instead because it was the simplest of all and it didn't matter for my purposes whether it was modal or not. I was just pointing out some of the problems for others in case they wanted to use your one-liner.

Strange behavior with this WScript. It's still a nice method