' This code was originally written by Dev Ashish.
' It is not to be altered or distributed,
' except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
'
' Code Courtesy of
' Dev Ashish
'
Private Declare Function apiGetClassName Lib "user32" _
Alias "GetClassNameA" _
(ByVal hWnd As Long, _
ByVal lpClassname As String, _
ByVal nMaxCount As Long) _
As Long
Private Declare Function apiGetWindowText Lib "user32" _
Alias "GetWindowTextA" _
(ByVal hWnd As Long, _
ByVal lpString As String, _
ByVal aint As Long) _
As Long
Private Declare Function apiGetLastActivePopup Lib "user32" _
Alias "GetLastActivePopup" _
(ByVal hWndOwnder As Long) _
As Long
Private Declare Function apiShowWindow Lib "user32" _
Alias "ShowWindow" _
(ByVal hWnd As Long, _
ByVal nCmdShow As Long) _
As Long
Private Const MAX_LEN = 255
Private Const GW_HWNDNEXT = 2
Private Const SW_HIDE = 0
Private Const SW_MINIMIZE = 6
Private Const SW_SHOWMINNOACTIVE = 7
Private Const SW_SHOWDEFAULT = 10
Sub sWatchAccess(ByVal hWndApp As Long)
'Required: hWndAccessApp (Application handle)
'
On Error GoTo Err_Handler
Dim lnghWndChild As Long
Dim strCaption As String
Dim strClass As String
Dim lngRet As Long
'Get the last active popup in hWndApp instance
lnghWndChild = apiGetLastActivePopup(hWndApp)
strClass = fGetClassName(lnghWndChild)
strCaption = fGetCaption(lnghWndChild)
'is this the modal window?
If strClass = "#32770" And Trim(strCaption) = "Printing" Then
lngRet = apiShowWindow(lnghWndChild, SW_SHOWMINNOACTIVE)
End If
Exit_Here:
Exit Sub
Err_Handler:
MsgBox "Error #: " & Err.Number & vbCrLf & Err.Description, _
vbCritical + vbOKOnly, "sWatchAccess-Runtime Error"
Resume Exit_Here
End Sub
Private Function fGetClassName(ByVal hWnd As Long) As String
Dim strBuffer As String
Dim lngRet As Long
strBuffer = String$(32, 0)
lngRet = apiGetClassName(hWnd, strBuffer, Len(strBuffer))
If lngRet > 0 Then
fGetClassName = Left$(strBuffer, lngRet)
End If
End Function
Private Function fGetCaption(ByVal hWnd As Long) As String
Dim strBuffer As String
Dim lngRet As Long
strBuffer = String$(MAX_LEN, 0)
lngRet = apiGetWindowText(hWnd, strBuffer, Len(strBuffer))
If lngRet > 0 Then
fGetCaption = Left$(strBuffer, lngRet)
End If
End Function