Option Explicit
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL] VBA7 Then
Private Declare PtrSafe Function ObjectFromLresult Lib "oleacc" (ByVal lResult As LongPtr, riid As Any, ByVal wParam As LongPtr, ppvObject As Any) As Long
Private Declare PtrSafe Function IIDFromString Lib "ole32.dll" (ByVal lpsz As LongPtr, lpiid As GUID) As LongPtr
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hClient As LongPtr, ByVal Msg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
Private Declare PtrSafe Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hClient As LongPtr, ByVal wFlag As Long) As LongPtr
Private Declare PtrSafe Function GetParent Lib "user32" (ByVal hClient As LongPtr) As LongPtr
Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hClient As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare PtrSafe Function GetDesktopWindow Lib "user32" () As LongPtr
Private Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hClient As LongPtr, ByVal lpString As String, ByVal cch As Long) As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL]
Private Declare Function ObjectFromLresult Lib "oleacc" (ByVal lResult As Long, riid As Any, ByVal wParam As Long, ppvObject As Any) As Long
Private Declare Function IIDFromString Lib "ole32.dll" (ByVal lpsz As Long, lpiid As GUID) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hClient As Long, ByVal Msg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hClient As Long, ByVal wFlag As Long) As Long
Private Declare Function GetParent Lib "user32" (ByVal hClient As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hClient As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hClient As Long, ByVal lpString As String, ByVal cch As Long) As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL] If
Private Const WM_GETOBJECT = &H3D&
Private Const OBJID_CLIENT = &HFFFFFFFC
Private Const GW_HWNDNEXT = 2
Private Const GW_CHILD = 5
Private Const S_OK = 0
Function GeRemotetUserFormObject(ByVal FormCaption As String) As Object
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL] VBA7 Then
Dim hChild As LongPtr, hClient As LongPtr, lResult As LongPtr
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL]
Dim hChild As Long, hClient As Long, lResult As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL] If
Const IID_IDISPATCH = "{00020400-0000-0000-C000-000000000046}"
Dim uGUID As GUID
Dim ret As Long, sBuffer As String * 256
Dim oUfrm As Object
hChild = GetNextWindow(GetDesktopWindow, GW_CHILD)
Do Until hChild = 0
ret = GetClassName(hChild, sBuffer, 256)
If Left(sBuffer, ret) = "ThunderDFrame" Or Left(sBuffer, ret) = "ThunderXFrame" Then
ret = GetWindowText(hChild, sBuffer, 256)
If Left(sBuffer, ret) = FormCaption Then
If GetParent(hChild) <> Application.hwnd Then
Exit Do
End If
End If
End If
hChild = GetNextWindow(hChild, GW_HWNDNEXT)
Loop
hClient = GetNextWindow(hChild, GW_CHILD)
lResult = SendMessage(hClient, WM_GETOBJECT, 0, ByVal OBJID_CLIENT)
If lResult Then
If IIDFromString(StrPtr(IID_IDISPATCH), uGUID) = S_OK Then
If ObjectFromLresult(lResult, uGUID, 0, oUfrm) = S_OK Then
If Not oUfrm Is Nothing Then
Set GeRemotetUserFormObject = oUfrm
End If
End If
End If
Else
Debug.Print " UserForm Not Found!"
End If
End Function