How to set ie object direct from hWnd

How to set ie object direct from  hWnd
Hi experts/
below sub program test1()
I have tested ,It works OK winxp/ie7.0

but in Vista/ie8.0 it has problem to get some specific ieframe(ie windows)
Which is to say the ie windows I want can’t find in winShell
but I I can use this ie handle close the ie windows,just  don't know how to  set to objIE in vista/ie8.0

So ,is there any way has Magic function like below

hWnd = 6817178 'ie window handle
set objie=magic(hWnd)
How to write the magic(hWnd) to set objIE?

instead  use
‘—{
a=6817178
For Each w In winShell  ' (some ie don't contain in the winShell ,so can't find it)
If w.hwnd = a Then
         Set objIE = w
         Exit For
      End If
next
‘-----}



' Test1() works fine in winxp/ie70 ,but in vista/ie8.0 has some problem
Sub test1()
Dim a As Long
Dim objIE As shdocvw.InternetExplorer
Dim winShell As SHDocVw.ShellWindows
Dim w As Object

a = 6817178 'ie window handle
SetForegroundWindow a

Set winShell = New SHDocVw.ShellWindows
For Each w In winShell
      If w.hwnd = a Then
         Set objIE = w
         Exit For
      End If
Next

Set winShell = Nothing
objIE.Refresh
Do While objIE.Busy = True
    Debug.Print "waiting"
Loop
Debug.Print "done"
End Sub
dayproAsked:
Who is Participating?
 
Surone1Commented:
are we talking vba or vb6?
0
 
Surone1Commented:
0
Cloud Class® Course: MCSA MCSE Windows Server 2012

This course teaches how to install and configure Windows Server 2012 R2.  It is the first step on your path to becoming a Microsoft Certified Solutions Expert (MCSE).

 
dayproAuthor Commented:
Thanks for the reply
using  vb6 program

is there any way has Magic function like below

hWnd = 6817178 'ie window handle
set objie=magic(hWnd) ''???

How to write the magic(hWnd)  set to objIE?

so i can control over objIe  object

instead  use
‘—{
a=6817178
For Each w In winShell  ' (some ie don't contain in the winShell ,so can't find it)
If w.hwnd = a Then
         Set objIE = w 'in winxp/ie7.0 work fine, but vista/ie8.0 has problem find some ie windows
         Exit For
      End If
next
‘-----}

0
 
Surone1Commented:
uhm wait..
lets try to simplify this...


Dim objIE As shdocvw.InternetExplorer
set objIE = createobject("shdocvw.InternetExplorer")
0
 
dayproAuthor Commented:
Thanks for the reply
I have test above program in winxp/ie7.8 vb6

attach is my test probram,
can you see what's wrong?

main error is    about  address of
 show error about   EnumChildWindows hWnd, AddressOf EnumChildProc, hWnd

Private Sub Command1_Click()
a = 198360 'from another program get the ie hWnd test
Dim objIE As Object
Set objIE = IEDOMFromhWnd(a) ' show error about   EnumChildWindows hWnd, AddressOf EnumChildProc, hWnd
End Sub



thanks


'---program begin
'
' Requires: reference to "Microsoft HTML Object Library"
'

Private Type UUID
   Data1 As Long
   Data2 As Integer
   Data3 As Integer
   Data4(0 To 7) As Byte
End Type

Private Declare Function GetClassName Lib "user32" _
   Alias "GetClassNameA" ( _
   ByVal hWnd As Long, _
   ByVal lpClassName As String, _
   ByVal nMaxCount As Long) As Long

Private Declare Function EnumChildWindows Lib "user32" ( _
   ByVal hWndParent As Long, _
   ByVal lpEnumFunc As Long, _
   lParam As Long) As Long

Private Declare Function RegisterWindowMessage Lib "user32" _
   Alias "RegisterWindowMessageA" ( _
   ByVal lpString As String) As Long

Private Declare Function SendMessageTimeout Lib "user32" _
   Alias "SendMessageTimeoutA" ( _
   ByVal hWnd As Long, _
   ByVal msg As Long, _
   ByVal wParam As Long, _
   lParam As Any, _
   ByVal fuFlags As Long, _
   ByVal uTimeout As Long, _
   lpdwResult As Long) As Long
      
Private Const SMTO_ABORTIFHUNG = &H2

Private Declare Function ObjectFromLresult Lib "oleacc" ( _
   ByVal lResult As Long, _
   riid As UUID, _
   ByVal wParam As Long, _
   ppvObject As Any) As Long

Private Declare Function FindWindow Lib "user32" _
   Alias "FindWindowA" ( _
   ByVal lpClassName As String, _
   ByVal lpWindowName As String) As Long

'
' IEDOMFromhWnd
'
' Returns the IHTMLDocument interface from a WebBrowser window
'
' hWnd - Window handle of the control
'
Function IEDOMFromhWnd(ByVal hWnd As Long) As IHTMLDocument
Dim IID_IHTMLDocument As UUID
Dim hWndChild As Long
Dim lRes As Long
Dim lMsg As Long
Dim hr As Long

   If hWnd <> 0 Then
      
      If Not IsIEServerWindow(hWnd) Then
      
         ' Find a child IE server window
         EnumChildWindows hWnd, AddressOf EnumChildProc, hWnd
         
      End If
      
      If hWnd <> 0 Then
            
         ' Register the message
         lMsg = RegisterWindowMessage("WM_HTML_GETOBJECT")
            
         ' Get the object pointer
         Call SendMessageTimeout(hWnd, lMsg, 0, 0, _
                 SMTO_ABORTIFHUNG, 1000, lRes)

         If lRes Then
               
            ' Initialize the interface ID
            With IID_IHTMLDocument
               .Data1 = &H626FC520
               .Data2 = &HA41E
               .Data3 = &H11CF
               .Data4(0) = &HA7
               .Data4(1) = &H31
               .Data4(2) = &H0
               .Data4(3) = &HA0
               .Data4(4) = &HC9
               .Data4(5) = &H8
               .Data4(6) = &H26
               .Data4(7) = &H37
            End With
               
            ' Get the object from lRes
            hr = ObjectFromLresult(lRes, IID_IHTMLDocument, 0, IEDOMFromhWnd)
               
         End If

      End If
      
   End If

End Function

Private Function IsIEServerWindow(ByVal hWnd As Long) As Boolean
Dim lRes As Long
Dim sClassName As String

   ' Initialize the buffer
   sClassName = String$(100, 0)
   
   ' Get the window class name
   lRes = GetClassName(hWnd, sClassName, Len(sClassName))
   sClassName = Left$(sClassName, lRes)
   
   IsIEServerWindow = StrComp(sClassName, _
                      "Internet Explorer_Server", _
                      vbTextCompare) = 0
   
End Function

'
' Copy this function to a .bas module
'
Function EnumChildProc(ByVal hWnd As Long, lParam As Long) As Long
   
   If IsIEServerWindow(hWnd) Then
      lParam = hWnd
   Else
      EnumChildProc = 1
   End If
   
End Function


Private Sub Command1_Click()
a = 198360 'from another program get the ie hWnd test
Dim objIE As Object
Set objIE = IEDOMFromhWnd(a) ' show error about   EnumChildWindows hWnd, AddressOf EnumChildProc, hWnd
End Sub
'--program end

Open in new window

0
 
ArkConnect With a Mentor Commented:
Did you read this:
' Copy this function to a .bas module
?
0
 
dayproAuthor Commented:
thanks for the hint
i have adjust, test program as attach code
why  comman2_click() run ok in win/xp ie7.0 well(can show objie.locationurl
but command1_click()   'why objie don't have .LocationURL even in xp/ie7.0

Private Sub Command1_Click()
  a = 198360 'from another program get the ie hWnd to test
  Dim objIE As Object
  Set objIE = IEDOMFromhWnd(a) ' pass
  Print objIE.LocationURL 'error ,why objie don't have .LocationURL
End Sub

Private Sub Command2_Click()
Dim dWinFolder As New ShellWindows
Dim objIE As Object
        For Each objIE In dWinFolder
          Print objIE.LocationURL 'it run ok ,can show .LocationURLl, but in vista/ie8 some ie can't get
        Next

End Sub

'-----.frm code begin
'
' Requires: reference to "Microsoft HTML Object Library"
'

Private Type UUID
   Data1 As Long
   Data2 As Integer
   Data3 As Integer
   Data4(0 To 7) As Byte
End Type


Private Declare Function EnumChildWindows Lib "user32" ( _
   ByVal hWndParent As Long, _
   ByVal lpEnumFunc As Long, _
   lParam As Long) As Long

Private Declare Function RegisterWindowMessage Lib "user32" _
   Alias "RegisterWindowMessageA" ( _
   ByVal lpString As String) As Long

Private Declare Function SendMessageTimeout Lib "user32" _
   Alias "SendMessageTimeoutA" ( _
   ByVal hWnd As Long, _
   ByVal msg As Long, _
   ByVal wParam As Long, _
   lParam As Any, _
   ByVal fuFlags As Long, _
   ByVal uTimeout As Long, _
   lpdwResult As Long) As Long
      
Private Const SMTO_ABORTIFHUNG = &H2

Private Declare Function ObjectFromLresult Lib "oleacc" ( _
   ByVal lResult As Long, _
   riid As UUID, _
   ByVal wParam As Long, _
   ppvObject As Any) As Long

Private Declare Function FindWindow Lib "user32" _
   Alias "FindWindowA" ( _
   ByVal lpClassName As String, _
   ByVal lpWindowName As String) As Long

'
' IEDOMFromhWnd
'
' Returns the IHTMLDocument interface from a WebBrowser window
'
' hWnd - Window handle of the control
'
Function IEDOMFromhWnd(ByVal hWnd As Long) As IHTMLDocument
Dim IID_IHTMLDocument As UUID
Dim hWndChild As Long
Dim lRes As Long
Dim lMsg As Long
Dim hr As Long

   If hWnd <> 0 Then
      
      If Not IsIEServerWindow(hWnd) Then
      
         ' Find a child IE server window
         EnumChildWindows hWnd, AddressOf EnumChildProc, hWnd
         
      End If
      
      If hWnd <> 0 Then
            
         ' Register the message
         lMsg = RegisterWindowMessage("WM_HTML_GETOBJECT")
            
         ' Get the object pointer
         Call SendMessageTimeout(hWnd, lMsg, 0, 0, _
                 SMTO_ABORTIFHUNG, 1000, lRes)

         If lRes Then
               
            ' Initialize the interface ID
            With IID_IHTMLDocument
               .Data1 = &H626FC520
               .Data2 = &HA41E
               .Data3 = &H11CF
               .Data4(0) = &HA7
               .Data4(1) = &H31
               .Data4(2) = &H0
               .Data4(3) = &HA0
               .Data4(4) = &HC9
               .Data4(5) = &H8
               .Data4(6) = &H26
               .Data4(7) = &H37
            End With
               
            ' Get the object from lRes
            hr = ObjectFromLresult(lRes, IID_IHTMLDocument, 0, IEDOMFromhWnd)
               
         End If

      End If
      
   End If

End Function

Private Sub Command1_Click()
  a = 198360 'from another program get the ie hWnd to test

  Dim objIE As Object
  Set objIE = IEDOMFromhWnd(a) '
  Print objIE.LocationURL 'why objie don't have .LocationURL

End Sub

Private Sub Command2_Click()
Dim dWinFolder As New ShellWindows
Dim objIE As Object
        For Each objIE In dWinFolder
          Print objIE.LocationURL 'it run ok
        Next

End Sub
'-----.frm code end


'.bas cod begin
'
' Copy this function to a .bas module
Public Declare Function GetClassName Lib "user32" _
   Alias "GetClassNameA" ( _
   ByVal hWnd As Long, _
   ByVal lpClassName As String, _
   ByVal nMaxCount As Long) As Long

'
Public Function EnumChildProc(ByVal hWnd As Long, lParam As Long) As Long
   
   If IsIEServerWindow(hWnd) Then
      lParam = hWnd
   Else
      EnumChildProc = 1
   End If
   
End Function

Public Function IsIEServerWindow(ByVal hWnd As Long) As Boolean
Dim lRes As Long
Dim sClassName As String

   ' Initialize the buffer
   sClassName = String$(100, 0)
   
   ' Get the window class name
   lRes = GetClassName(hWnd, sClassName, Len(sClassName))
   sClassName = Left$(sClassName, lRes)
   
   IsIEServerWindow = StrComp(sClassName, _
                      "Internet Explorer_Server", _
                      vbTextCompare) = 0
   
End Function


'.bas cod end

Open in new window

0
 
ArkConnect With a Mentor Commented:
IEDOMFromhWnd return IHTMLDocument2 interface, not WebBrowser control
See http://msdn.microsoft.com/en-us/library/aa752574(VS.85).aspx for this interface members. If you need URL, use
Dim oDoc As Object
  Set oDoc = IEDOMFromhWnd(a) ' pass
  Print Doc.URL 'error ,why objie don't have .LocationURL
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.