Solved

How to set ie object direct from  hWnd

Posted on 2010-08-21
9
2,081 Views
Last Modified: 2012-05-10
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
0
Comment
Question by:daypro
  • 3
  • 3
  • 3
9 Comments
 
LVL 13

Expert Comment

by:Surone1
ID: 33493820
are we talking vba or vb6?
0
 
LVL 13

Expert Comment

by:Surone1
ID: 33493914
0
 

Author Comment

by:daypro
ID: 33494275
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
 
LVL 13

Expert Comment

by:Surone1
ID: 33495362
uhm wait..
lets try to simplify this...


Dim objIE As shdocvw.InternetExplorer
set objIE = createobject("shdocvw.InternetExplorer")
0
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
LVL 27

Accepted Solution

by:
Ark earned 500 total points
ID: 33508394
0
 

Author Comment

by:daypro
ID: 33539275
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
 
LVL 27

Assisted Solution

by:Ark
Ark earned 500 total points
ID: 33539882
Did you read this:
' Copy this function to a .bas module
?
0
 

Author Comment

by:daypro
ID: 33541202
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
 
LVL 27

Assisted Solution

by:Ark
Ark earned 500 total points
ID: 33547396
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

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction While answering a recent question about filtering a custom class collection, I realized that this could be accomplished with very little code by using the ScriptControl (SC) library.  This article will introduce you to the SC library a…
The debugging module of the VB 6 IDE can be accessed by way of the Debug menu item. That menu item can normally be found in the IDE's main menu line as shown in this picture.   There is also a companion Debug Toolbar that looks like the followin…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

911 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

16 Experts available now in Live!

Get 1:1 Help Now