VBA управление IE.....

Option Compare Database
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal _
lpClassName As String, ByVal lpWindowName As String) As Long
 
Private Declare Function EnumChildWindows _
Lib "user32" (ByVal hwnd As Long, ByVal _
lpWndProc As Long, ByVal lp As Long) As Long
 
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 RegisterWindowMessage Lib "user32.dll" 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, ByVal lParam As Long, ByVal fuFlags As Long, ByVal uTimeout As Long, lpdwResult As Long) As Long
    
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
 
  
    Private Type UUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
    End Type
    
Private Const SMTO_ABORTIFHUNG = &H2
 
 
Private Sub Êíîïêà0_Click()
Dim hW As Long
Dim HTMLDoc As Object
 
hW = FindWindow(vbNullString, "Àâòîðèçàöèÿ - Microsoft Internet Explorer" & Chr(0))
MsgBox (hW)
Set HTMLDoc = IEDOMFromhWnd(hW)
HTMLDoc.navigate = "about:blank"
End Sub
 
Public 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
      EnumChildWindows hwnd, AddressOf EnumChildProc, hwnd
    End If
    If hwnd <> 0 Then
      lMsg = RegisterWindowMessage("WM_HTML_GETOBJECT")
      SendMessageTimeout hwnd, lMsg, 0, 0, SMTO_ABORTIFHUNG, 1000, lRes
      If lRes Then
        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
        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
  sClassName = String$(100, 0)
  lRes = GetClassName(hwnd, sClassName, Len(sClassName))
  sClassName = Left$(sClassName, lRes)
  IsIEServerWindow = StrComp(sClassName, "Internet Explorer_Server", vbTextCompare) = 0
End Function
 
 
Public Function EnumChildProc(ByVal hW As Long, lParam As Long) As Long
  If IsIEServerWindow(hW) Then
    lParam = hW
  Else
    EnumChildProc = 1
  End If
End Function

Sub test()
   Dim Shell As Object
   Dim Wins As Object
   Dim WinItem As Variant
   Dim oDoc As Object
   
   Const SiteURL As String = "http://www.google.ru/"
   
   Set Shell = CreateObject("shell.application")
   
   For Each WinItem In Shell.Windows
      If WinItem.LocationURL = SiteURL Then
         Set oDoc = WinItem.Document
      End If
   Next
End Sub

Sub test()
   
   Dim Shell As Object
   Dim Wins As Object
   Dim WinItem As Variant
   Dim oDoc As Object
   
   Const SiteURL As String = "http://www.google.ru/"
   
   Set Shell = CreateObject("shell.application")
   
   For Each WinItem In Shell.Windows
      If WinItem.LocationURL = SiteURL Then
         Set oDoc = WinItem.Document
      End If
   Next
   ' 1 коллекция инпутов
   Set objCollection = oDoc.getElementsByTagName("input")
   Dim InputName As String
    ' 2 ищем инпут с именем поле поиска на странице гугла
    ' там у него наименование - q и вставляем в него текст
    While i < objCollection.length
    If objCollection(i).Name = "q" Then
       objCollection(i).Value = "Заполняем поиск тем что нужно"
    End If
      i = i + 1
   Wend
 i = 0
 End Sub

Set objCollection = oDoc.getElementsByTagName("input")

Set objCollection = oDoc.Frames(1).Document.getElementsByTagName("input")

   For Each WinItem In Shell.Windows
      If WinItem.LocationURL = SiteURL Then
      MsgBox ("Нашел гугл")
         Set oDoc = WinItem.Document
    Else
      MsgBox ("Не Нашел гугл")
      End If
   Next

'Помещаем текст в активный текстбокс (где курсор находится).
'Документ.activeElement.setAttribute strAttributeName:="value", _
    AttributeValue:="text"
'Узнаём, что содержится в активном текстбоксе
'(чтобы увидеть результат: View - Immediate Window).
DebugPrint = Документ.activeElement.getAttribute(strAttributeName:="value")

'условие, ести не открыт Интернет Эксплойер, тогда ...
    If Tasks.Exists(Name:="Windows Internet Explorer") = False Then Exit Sub

Dim objCollectionIf As Object
   Dim Shell As Object
   Dim Wins As Object
   Dim WinItem As Variant
   Dim oDoc As Object
   Dim InputName As String
   Const SiteURL As String = "http://www.yandex.ru/"
   
   Set Shell = CreateObject("shell.application")
   
   For Each WinItem In Shell.Windows
      If WinItem.LocationURL = SiteURL Then
         Set oDoc = WinItem.Document
    Else
      End If
   Next
 
   Set objCollectionIf = oDoc.getElementsByTagName("input")
   
   While i < objCollectionIf.Length
   If objCollectionIf(i).Name = "text" Then
     objCollectionIf(i).Value = "Щас найдем что нужно"
   End If
    i = i + 1
   Wend
 i = 0

count=0
For Each WinItem In Shell.Windows
count = count+1
   Next

objCollectionIfType = objCollectionIf(i).Type

Set objCollectionIf = oDoc.getElementsByTagName("input")

While i < objCollectionIf.Length
   'If objCollectionIf(i).Name = "text" Then
   If (objCollectionIf(i).Type = "submit") _
   And (objCollectionIf(i).Value = "Найти") Then
     objCollectionIf(i).Value = "Щас найдем что нужно"
   End If
    i = i + 1
   Wend
 i = 0

Set objCollectionIf = oDoc.getElementsByTagName("a")
   
   While i < objCollectionIf.Length
   'MsgBox (objCollectionIf(i).Title)
   If objCollectionIf(i).Title = "Уточнить сведения" Then
     objCollectionIf(i).OnClick ' вызываем событие клика у полученного элемента 
   End If
   i = i + 1
   Wend
 i = 0