Option Compare Database
Option Explicit
' Module Name: ModFindWindowLike
' (c) 2005 Wayne Phillips (http://www.everythingaccess.com)
' Written 02/06/2005
'
' mODIFIED bY aRNELgP FOR x64 aCCESS
'
#If VBA7 Then
Private Declare PtrSafe Function EnumWindows Lib "user32" (ByVal lpEnumFunc As LongPtr, ByVal lParam As LongPtr) As Long
Private Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As LongPtr, ByVal lpString As String, ByVal cch As Long) As Long
'Could use global variables instead, but this is nicer.
'Custom structure for passing in the parameters in/out of the hook enumeration function
'Could use global variables instead, but this is nicer.
Private Type FindWindowParameters
strTitle As String 'INPUT
hWnd As LongPtr 'OUTPUT
End Type
#Else
Private Declare Function EnumWindows Lib "user32" _
(ByVal lpEnumFunc As Long, _
ByVal lParam As Long) As Long
Private Declare Function GetWindowText Lib "user32" _
Alias "GetWindowTextA" _
(ByVal hwnd As Long, _
ByVal lpString As String, _
ByVal cch As Long) As Long
'Could use global variables instead, but this is nicer.
'Custom structure for passing in the parameters in/out of the hook enumeration function
'Could use global variables instead, but this is nicer.
Private Type FindWindowParameters
strTitle As String 'INPUT
hWnd As Long 'OUTPUT
End Type
#End If
'''experimental''''''''''''''''
Private Const WM_CHAR = &H102
Private Const BM_CLICK As Long = &HF5&
''' close the window
Private Const WM_SYSCOMMAND = &H112
Private Const SC_CLOSE = &HF060
#If VBA7 Then
Private Declare PtrSafe Function SendMessageBynum Lib "user32" Alias "SendMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
Private Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As Long
#Else
private Declare Function SendMessageBynum Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As any) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
#End If
'''''''''''''''''''''
#If VBA7 Then
Public Function FnFindWindowLike(strWindowTitle As String) As LongPtr
#Else
Public Function FnFindWindowLike(strWindowTitle As String) As Long
#End If
'We'll pass a custom structure in as the parameter to store our result...
Dim Parameters As FindWindowParameters
Parameters.strTitle = UCase(strWindowTitle) ' Input parameter
#If VBA7 Then
Call EnumWindows(AddressOf EnumWindowProc, VarPtr(Parameters))
#Else
Call EnumWindows(AddressOf EnumWindowProc, VarPtr(Parameters))
#End If
FnFindWindowLike = Parameters.hWnd
End Function
#If VBA7 Then
Private Function EnumWindowProc(ByVal hWnd As LongPtr, _
lParam As FindWindowParameters) As LongPtr
#Else
Private Function EnumWindowProc(ByVal hWnd As Long, _
lParam As FindWindowParameters) As Long
#End If
Dim strWindowTitle As String
strWindowTitle = Space(260)
Call GetWindowText(hWnd, strWindowTitle, 260)
strWindowTitle = UCase(TrimNull(strWindowTitle)) ' Remove extra null terminator
If strWindowTitle Like lParam.strTitle Then
lParam.hWnd = hWnd 'Store the result for later.
EnumWindowProc = 0 'This will stop enumerating more windows
Else
EnumWindowProc = 1
End If
End Function
Private Function TrimNull(strNullTerminatedString As String)
Dim lngPos As Long
'Remove unnecessary null terminator
lngPos = InStr(strNullTerminatedString, Chr$(0))
If lngPos Then
TrimNull = Left$(strNullTerminatedString, lngPos - 1)
Else
TrimNull = strNullTerminatedString
End If
'Debug.Print TrimNull
End Function
)