Private Declare Function apiShowWindow Lib "user32" Alias "ShowWindow" _
            (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long

Private Sub CommandButton5_Click()

Dim IE As Object
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
apiShowWindow IE.hwnd, 3   ' если вместо 11 ставим 3 то IE будет на весь экран
IE.navigate ("http://se.fedresurs.ru/messages/IsSearching")
Do While (IE.readyState <> 4) And (IE.readyState <> 3): DoEvents: Loop  ' ждем окончания загрузки
While IE.document Is Nothing: DoEvents: Wend
Application.Wait (Now + TimeValue("0:00:3"))  'делаем паузу
Dim Doc As HTMLDocument
Set Doc = IE.document

'Открываем окно <iframe
Dim VseImg_Elements As IHTMLElementCollection
Dim VImg As IHTMLElement
Set VseImg_Elements = Doc.getElementsByTagName("img")
ImgTipMessage = "ctl00_MainContent_sfMessageType_imgSelect"
For Each VImg In VseImg_Elements
  If VImg.ID = ImgTipMessage Then
    VImg.Click
    Exit For
  End If
Next VImg

Do While (IE.readyState <> 4) And (IE.readyState <> 3): DoEvents: Loop  ' ждем окончания загрузки
Application.Wait (Now + TimeValue("0:00:3"))  'делаем паузу

' определяем документ фрейма
Dim DocIframe As HTMLDocument
Set DocIframe = Doc.frames(0).document

'находим строку ввода
Dim F_VseInput_Elements As IHTMLElementCollection
Dim F_VInp As IHTMLElement
Set F_VseInput_Elements = DocIframe.getElementsByTagName("input")
For Each F_VInp In F_VseInput_Elements
  If F_VInp.ID = "ctl00_MainContent_tbSearch" Then
    F_VInp.Value = "Намерение должника обратиться в суд с заявлением о банкротстве"
    Exit For
  End If
Next F_VInp
Application.Wait (Now + TimeValue("0:00:3"))  'делаем паузу

'нажимаем кнопку Поиск
For Each F_VInp In F_VseInput_Elements
  If F_VInp.ID = "ctl00_MainContent_btnSearch" Then
    F_VInp.Click
    Exit For
  End If
Next F_VInp
Application.Wait (Now + TimeValue("0:00:3"))  'делаем паузу

'определяем все div страницы фрейм
Dim F_VseDiv_Elements As IHTMLElementCollection
Dim F_VDiv As IHTMLElement
Dim F_Li As IHTMLElement
Set F_VseDiv_Elements = DocIframe.getElementsByTagName("div")

'находим конкретный div строки "Намерение должника обратиться в суд с заявлением о банкротстве"
' по критерию уникальное имя класса rtMid rtSelected
For Each F_VDiv In F_VseDiv_Elements
  If F_VDiv.className = "rtMid rtSelected" Then
    MsgBox "Нашли"
    ' переходим на родителя Li
    Set F_Li = F_VDiv.parentElement
    MsgBox F_Li.innerText ' проверяем на того ли родителя попали
    F_Li.Click ' пытаемся нажать на Li типа выбрать элемент Li
               ' соответствующий "Намерение должника обратиться в суд с заявлением о банкротстве"
    Exit For
  End If
Next F_VDiv
  
End Sub

Dim IE As Object
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
apiShowWindow IE.hwnd, 3   ' если вместо 11 ставим 3 то IE будет на весь экран
IE.navigate ("http://se.fedresurs.ru/messages/IsSearching")
Do While (IE.readyState <> 4) And (IE.readyState <> 3): DoEvents: Loop  ' ждем окончания загрузки
While IE.document Is Nothing: DoEvents: Wend
Application.Wait (Now + TimeValue("0:00:5"))  'делаем паузу
Dim Doc As HTMLDocument
Set Doc = IE.document

Dim VseImg_Elements As IHTMLElementCollection
Dim VImg As IHTMLElement
Set VseImg_Elements = Doc.getElementsByTagName("img")
ImgTipMessage = "ctl00_MainContent_sfMessageType_imgSelect"
For Each VImg In VseImg_Elements
  If VImg.ID = ImgTipMessage Then
    VImg.Click
    Exit For
  End If
Next VImg


' Далее надо добираться до <li формы

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx& Lib "user32" _
Alias "FindWindowExA" (ByVal hWndParent As Long, ByVal hWndChildAfter As Long, ByVal lpClassName As String, ByVal lpWindowName As String)

Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
Private Declare Function PostMessage Lib "user32.dll" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Declare Function apiShowWindow Lib "user32" Alias "ShowWindow" _
            (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long

Private Const WM_SETTEXT = &HC  'константа изменения текста
Private Const BM_CLICK = &HF5  'константа нажатие кнопки


Private Sub CommandButton1_Click()
  
  Dim IE1 As InternetExplorer
  Set IE1 = New InternetExplorer
  IE1.Visible = True  'делаем IE видимым
  apiShowWindow IE1.hwnd, 3   ' если вместо 11 ставим 3 то IE будет на весь экран
  SsilkaFile = "http://kad.arbitr.ru/PdfDocument/4718462b-4ceb-408d-b92d-4fa111acec1b/814ddff0-ff88-48ce-a2bd-a8a3b1d6c452/%2060-58225-2014__20180327.pdf"
  IE1.navigate SsilkaFile  ' загружаем ссылку
  Do While (IE1.readyState <> 4) And (IE1.readyState <> 3): DoEvents: Loop  ' ждем окончания загрузки
  While IE1.document Is Nothing: DoEvents: Wend
  Application.Wait (Now + TimeValue("0:00:5"))  'делаем паузу

  IE1.ExecWB 4, 1 'открываем диалоговое окно "Сохранить как ..."
  Application.Wait (Now + TimeValue("0:00:2"))  'делаем паузу

  Dim hwnd, hwndEdit, hwndEx, hwndBtnSave As Long
  hwnd = FindWindow(vbNullString, "Сохранение") 'находим хендл окна "Сохранить как.." по названию окна "Сохранение"
  
  hwndEx = FindWindowEx(hwnd, 0, "DUIViewWndClassName", vbNullString)
  hwndEx = FindWindowEx(hwndEx, 0, "DirectUIHWND", vbNullString)
  hwndEx = FindWindowEx(hwndEx, 0, "FloatNotifySink", vbNullString)
  hwndEx = FindWindowEx(hwndEx, 0, "ComboBox", vbNullString)
  hwndEx = FindWindowEx(hwndEx, 0, "Edit", vbNullString) 'последовательно добираемся до Эдит "Имя файла" т.е. куда будем сохранять файл


  SendMessage hwndEx, WM_SETTEXT, 0, ByVal "e:\999.pdf" 'меняем путь сохранения и имя конечного файла на необходимый
  
  hwndBtnSave = FindWindowEx(hwnd, 0, "Button", "Со&хранить") 'ищем хендл кнопки "Сохранить"
  PostMessage hwndBtnSave, BM_CLICK, 0, 0 'нажимаем кнопку "Сохранить

  IE1.Quit
End Sub

Private Declare Function apiShowWindow Lib "user32" Alias "ShowWindow" _
            (ByVal Hwnd As Long, ByVal nCmdShow As Long) As Long

Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
        
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
                                     (ByVal hWnd1 As Long, _
                                      ByVal hWnd2 As Long, _
                                      ByVal lpsz1 As String, _
                                      ByVal lpsz2 As String) _
                                      As Long

Private Sub CommandButton1_Click()

  Dim IE1 As InternetExplorer
  Set IE1 = New InternetExplorer
  IE1.Visible = True
  apiShowWindow IE1.Hwnd, 3
  IE1.navigate "http://kad.arbitr.ru/PdfDocument/4718462b-4ceb-408d-b92d-4fa111acec1b/0e6d3992-f771-4e09-9301-24e891...;
  Do While (IE1.readyState <> 4) And (IE1.readyState <> 3): DoEvents: Loop
  While IE1.document Is Nothing: DoEvents: Wend
  Application.Wait (Now + TimeValue("0:00:5"))
  SendKeys ("^+s")

MsgBox "Закипаю!!!!! АААААААААААААААААААААА!!!!!!"

End Sub

'------открываем страницу IE------
Dim IE As Object
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
apiShowWindow IE.hwnd, 3   ' если вместо 11 ставим 3 то IE будет на весь экран
IE.navigate ("http://www.rusprofile.ru")
Do While (IE.readyState <> 4) And (IE.readyState <> 3): DoEvents: Loop  ' ждем окончания загрузки
Application.Wait (Now + TimeValue("0:00:3"))  'делаем паузу
Dim Doc As HTMLDocument
Set Doc = IE.document

Dim VseInput As IHTMLElementCollection
Set VseInput = Doc.getElementsByTagName("input")  ' определяем все инпуты

'------------------переходим к вставке названия организации------------------
For Each VI In VseInput
  If VI.getAttribute("placeholder") = "Поиск по ОГРН, ИНН, названию, ФИО директора и адресу" Then
    VI.Select
    VI.Value = "комбинат" 'TabIshExcel.Cells(i, 2).Value
    Exit For
  End If
Next VI
Application.Wait (Now + TimeValue("0:00:2"))

'------------------нажимаем кнопку найти------------------
    
 Dim NaytiBtn As IHTMLElementCollection
Set NaytiBtn = Doc.getElementsByClassName("srch-btn")
    
    NaytiBtn(0).Click
Do While (IE.readyState <> 4) And (IE.readyState <> 3): DoEvents: Loop  ' ждем окончания загрузки
Application.Wait (Now + TimeValue("0:00:4"))  'делаем паузу



'-------------- Дальше засада------------------
Dim VseA As IHTMLElementCollection
Set VseA = Doc.getElementsByClassName("actye")  ' ссылку Действующие организации
 MsgBox VseA.Length
Dim AA As IHTMLElement
For Each AA In VseA
  MsgBox AA.innerText
  If InStr(1, AA.Text, "действующие", vbTextCompare) <> 0 Then
    AA.Click
    Exit For
  End If
Next AA

Dim A_Elements As IHTMLElementCollection
Dim A As IHTMLElement
Set A_Elements = Doc.getElementsByTagName("a")
Dim rr As Range
Set rr = Sheets("Лист2").Range("A1").CurrentRegion
Set rr = rr.Resize(A_Elements.Length, 4)

k = 1
For i = 0 To A_Elements.Length
  rr.Cells(k, 1).Value = A_Elements(i).getAttribute("href")
  rr.Cells(k, 2).Value = A_Elements(i).innerText
  k = k + 1
Next i
k = 1
For Each A In Doc.getElementsByTagName("a")
    rr.Cells(k, 3).Value = A.getAttribute("href")
    rr.Cells(k, 4).Value = A.innerText
     k = k + 1
    If A.getAttribute("href") = "http://ras.arbitr.ru/#page5" Then A.Click: Exit For
Next A

Private Sub CommandButton1_Click()
 Dim IE As Object
 Set IE = CreateObject("InternetExplorer.Application")
  IE.Visible = True
IE.Navigate ("http://ras.arbitr.ru")
  
Do While IE.readyState <> 4: DoEvents: Loop
 
 Dim Doc As HTMLDocument
Set Doc = IE.document
 
 
Dim INP_Elements As IHTMLElementCollection
Dim INP As IHTMLElement
Set INP_Elements = Doc.getElementsByTagName("input")
For Each INP In INP_Elements
    If INP.placeholder = "например, А50-5568/08" Then
        INP.Select
        INP.Value = "А40-16910/2014"
    End If
 
Next INP

Dim Button_Elements As IHTMLElementCollection
Dim BtnE As IHTMLElement
Set Button_Elements = Doc.getElementsByTagName("button")

Button_Elements(0).Click
'++++++++++++++++++++++++++++++++++++++++++++++++++

 
 '++++++++++++++++++++++++++++++++++++++++++++++++++
End Sub

IE.ExecWB OLECMDID_SELECTALL, OLECMDEXECOPT_DONTPROMPTUSER
IE.ExecWB OLECMDID_COPY, OLECMDEXECOPT_DONTPROMPTUSER
ActiveSheet.Paste