'***IN A FORM
Private Sub Form_Activate()
MsgBox "Test Message"
End Sub
Private Sub Form_Load()
Timer1.Interval = 1000
End Sub
Private Sub Timer1_Timer()
Dim lProcessID As Long
Dim lID As Long
Timer1.Interval = 0
'get the process ID for prosper
lProcessID = GetWindowThreadProcessId(Me.hWnd, lID)
'close any open message boxes
CloseMessageBox lProcessID
Form2.Show
End Sub
'***IN A MODULE
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal lWindowHwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal lWindowHwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function EnumThreadWindows Lib "user32" (ByVal dwThreadId As Long, ByVal lpfn As Long, ByVal lParam As Long) As Long
'used for message box closing
Public Declare Function GetWindowThreadProcessId Lib "user32" (ByVal lWindowHwnd As Long, lpdwProcessId As Long) As Long
Private Const MSGBOX_CLASS_ID = "#32770"
Private Const WM_GETTEXT = &HD
Private Const WM_CLOSE = &H10
Private Const BUFFER_SIZE As Integer = 255
Private lMsgBoxHwnd As Long
Private sMsgText As String
Private bMsgBox As Boolean
Public Sub CloseMessageBox(ByVal lOwnerProcess As Long)
On Error GoTo ErrorHandler:
Dim lProcessID As Long
Dim lID As Long
'reset the handle
lMsgBoxHwnd = 0
'enumerates top-level windows
Call EnumThreadWindows(lOwnerProcess, AddressOf EnumWindowProc, 0&)
'if a valid message box handle was found
If (lMsgBoxHwnd <> 0) Then
'send a message to close the message box
SendMessage lMsgBoxHwnd, WM_CLOSE, 0&, 0&
End If
Exit Sub
ErrorHandler:
End Sub
Private Function EnumWindowProc(ByVal lWindowHwnd As Long, ByVal lParam As Long) As Long
On Error GoTo ErrorHandler:
Dim sClassName As String
'create a buffer
sClassName = Space(BUFFER_SIZE)
'truncate the class name buffer
sClassName = Left(sClassName, GetClassName(lWindowHwnd, ByVal sClassName, BUFFER_SIZE))
'if a dialog class was found
If StrComp(Left(sClassName, Len(MSGBOX_CLASS_ID)), MSGBOX_CLASS_ID, vbTextCompare) = 0 Then
'verify it's a standard message box style dialog
If IsMsgBoxDialog(lWindowHwnd) Then
lMsgBoxHwnd = lWindowHwnd
lWindowHwnd = 0
End If
End If
'return the window handle
EnumWindowProc = lWindowHwnd
Exit Function
ErrorHandler:
End Function
Private Function IsMsgBoxProc(ByVal lWindowHwnd As Long, ByVal lParam As Long) As Long
On Error GoTo ErrorHandler:
Dim sClass As String
Dim sCaption As String
'create a buffer
sClass = Space(BUFFER_SIZE)
'extract the class name of this child window
sClass = Left(sClass, GetClassName(lWindowHwnd, ByVal sClass, BUFFER_SIZE))
'if a button class
If InStr(LCase(sClass), "button") Then
'create a buffer
sCaption = Space(BUFFER_SIZE)
'see if it's caption qualifies as a Msgbox button caption
sCaption = Left(sCaption, SendMessage(lWindowHwnd, WM_GETTEXT, BUFFER_SIZE, ByVal sCaption))
'is it a valid message box
If InStr(",OK,ABORT,RETRY,YES,NO,CANCEL,IGNORE,", "," & Replace(UCase(sCaption), "&", "") & ",") Then
lWindowHwnd = 0
bMsgBox = True
End If
End If
'return the handle
IsMsgBoxProc = lWindowHwnd
Exit Function
ErrorHandler:
End Function
Private Function IsMsgBoxDialog(ByVal lWindowHwnd As Long) As Boolean
On Error Resume Next
'reset the flag
bMsgBox = False
'enumerate child windows
Call EnumChildWindows(lWindowHwnd, AddressOf IsMsgBoxProc, 0&)
'return the success value
IsMsgBoxDialog = bMsgBox
End Function
