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
Suscribirse a:
Enviar comentarios (Atom)
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 ...
-
Option Compare Database Option Explicit 'Zip / UnZip file or folder 'http://www.codekabinett.com/rdumps.php?Lang=2&targetDoc...
-
Option Compare Database Option Explicit '***************************** ' 'Ejemplo de uso ' 'selecciona 1 ficher...
No hay comentarios:
Publicar un comentario