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

Do While IE.readyState <> 4 
DoEvents
Loop

Dim IE As Object
Set IE = CreateObject("InternetExplorer.Application")
 
IE.navigate ("https://www.cyberforum.ru/vba/thread328405-page3.html") 'открывает указанную в кавычках страницу в данном случае "ИЦ ГУВД по Челябинской области"
Sleep 1300 'задержка, то есть пауза выражается в миллисекундах, 1000 миллисекунд это 1 секунда
 
Do While IE.readyState <> 4 'нужно писать <> 4, потому что это код, который показывает, что ВЭБ страница полностью загружена. Так написано в документации по ReadyState
DoEvents
Loop
 
Стр_WEB = Trim$(IE.Document.body.innerText)

Dim IE As Object
Set IE = CreateObject("InternetExplorer.Application")
 
IE.navigate ("https://www.cyberforum.ru/vba/thread328405-page3.html") 'открывает указанную в кавычках страницу в данном случае "ИЦ ГУВД по Челябинской области"
Sleep 1300 'задержка, то есть пауза выражается в миллисекундах, 1000 миллисекунд это 1 секунда
 
Do While IE.readyState <> 4 'нужно писать <> 4, потому что это код, который показывает, что ВЭБ страница полностью загружена. Так написано в документации по ReadyState
DoEvents
Loop
 
'спуститься вниз документа
Selection.EndKey Unit:=wdStory
'вставить параграф, то есть абзац
Selection.TypeParagraph
Selection.TypeText Text:=Trim$(IE.Document.body.innerText)

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