viernes, 29 de septiembre de 2017

VBA Access. Módulo de clase clsWindowExists para comprobar si una ventana de aplicación Windows existe por su nombre parcial. Window Exists.

Option Compare Database
Option Explicit

'http://www.vbforums.com/showthread.php?316924-Find-Window-handle-by-Partial-Caption

'Windows API Function Declarations
#If Win64 = 1 Then
    Private Declare PtrSafe Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare PtrSafe Function GetWindowText Lib "User32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
    Private Declare PtrSafe Function GetWindowTextLength Lib "User32" Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As Long
    Private Declare PtrSafe Function GetWindow Lib "User32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
    Private Declare PtrSafe Function IsWindowVisible Lib "User32" (ByVal hWnd As Long) As Boolean
#Else
    Private Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function GetWindowText Lib "User32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
    Private Declare Function GetWindowTextLength Lib "User32" Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As Long
    Private Declare Function GetWindow Lib "User32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
    Private Declare Function IsWindowVisible Lib "User32" (ByVal hWnd As Long) As Boolean
#End If

#If Win64 = 1 Then
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) 'For 64 Bit Systems
#Else
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'For 32 Bit Systems
#End If

Private Const GW_HWNDNEXT = 2

Public Function WindowExists(ByVal PartialCaption As String) As Boolean
On Error GoTo error
    Dim lhWndP As Long
    If GetHandleFromPartialCaption(lhWndP, PartialCaption) = True Then
        If IsWindowVisible(lhWndP) = True Then
          Debug.Print "Found VISIBLE Window Handle: " & lhWndP, vbOKOnly + vbInformation
        Else
          Debug.Print "Found INVISIBLE Window Handle: " & lhWndP, vbOKOnly + vbInformation
        End If
     
        WindowExists = True
    Else
        Debug.Print "Window '" & PartialCaption & "' not found!", vbOKOnly + vbExclamation
        WindowExists = False
    End If

Exit Function
error:
    WindowExists = False
    Debug.Print Err.Number & ": " & Err.Description
End Function

Public Sub LoopWhileWindowsExists(ByVal PartialCaption As String, Optional ByVal CheckTimeMilliSeconds As Long = 3000)
On Error GoTo error
    Do
        Sleep (CheckTimeMilliSeconds)
    Loop Until Not WindowExists(PartialCaption)

Exit Sub
error:
    Debug.Print Err.Number & ": " & Err.Description
End Sub

Private Function GetHandleFromPartialCaption(ByRef lWnd As Long, ByVal sCaption As String) As Boolean
    Dim lhWndP As Long
    Dim sStr As String
    GetHandleFromPartialCaption = False
    lhWndP = FindWindow(vbNullString, vbNullString) 'PARENT WINDOW
    Do While lhWndP <> 0
        sStr = String(GetWindowTextLength(lhWndP) + 1, Chr$(0))
        GetWindowText lhWndP, sStr, Len(sStr)
        sStr = Left$(sStr, Len(sStr) - 1)
        If InStr(1, sStr, sCaption) > 0 Then
            GetHandleFromPartialCaption = True
            lWnd = lhWndP
            Exit Do
        End If
        lhWndP = GetWindow(lhWndP, GW_HWNDNEXT)
    Loop

End Function

No hay comentarios:

Publicar un comentario

VBA Access. Redondeo de números decimales con el método medio redondeo. Alternativa a la función Round (bankers round)

 Private Function Redondeo(ByVal Numero As Variant, ByVal Decimales As Integer) As Double     'Aplica método medio redondeo (half round ...