Копирование целевой таблицы из HTML в Excel не отображается

Question

Попытался выбрать выпадающие списки из файла HTML и попытался скопировать таблицу результатов в Excel.Но приведенный ниже код копирует какой-то другой текст из HTML, а не из таблицы (которую я хочу заполнить в Excel).

Option Explicit

'VBE > Tools > References:
' Microsoft Internet Controls
Public Sub MakeSelections()
    Dim ie As InternetExplorer, ele As Object, t As Date
    Const MAX_WAIT_SEC As Long = 5
    Dim commodity As String, iDate As String


    commodity = "MADHYA PRADESH"
    iDate = "REWA"

    Set ie = New InternetExplorer

    With ie
        .Visible = True
        .Navigate2 "http://hydro.imd.gov.in/hydrometweb/(S(3qitcijd521egpzhwqq3jk55))/DistrictRaifall.aspx"

        While .Busy Or .readyState < 4: DoEvents: Wend

        .document.querySelector("[value='" & commodity & "']").Selected = True
        .document.querySelector("[name=listItems]").FireEvent "onchange"
        t = Timer
        Do
            On Error Resume Next
            Set ele = .document.querySelector("[value='" & iDate & "']")
            On Error GoTo 0
            If Timer - t > MAX_WAIT_SEC Then Exit Do
        Loop While ele Is Nothing

        If Not ele Is Nothing Then
            ele.Selected = True
            .document.querySelector("#GoBtn").Click
        Else
            Exit Sub
        End If
        'Stop
        '.Quit


   Dim doc As Object, hTable As Object, hBody As Object, hTR As Object, hTD As Object
   Dim tb As Object, bb As Object, tr As Object, td As Object

   Dim y As Long, z As Long, wb As Excel.Workbook, ws As Excel.Worksheet

     Set wb = Excel.ActiveWorkbook
     Set ws = wb.ActiveSheet

      y = 1   'Column A in Excel
      z = 1   'Row 1 in Excel

     Set doc = ie.document
     Set hTable = doc.getElementsByTagName("table")
     For Each tb In hTable

        Set hBody = tb.getElementsByTagName("tbody")
        For Each bb In hBody

            Set hTR = bb.getElementsByTagName("tr")
            For Each tr In hTR


                 Set hTD = tr.getElementsByTagName("td")
                 y = 1 ' Resets back to column A
                 For Each td In hTD
                   ws.Cells(z, y).Value = td.innerText
                   y = y + 1
                 Next td
                 DoEvents
                 z = z + 1
            Next tr
            Exit For
        Next bb
    Exit For
  Next tb
    End With

End Sub

Answer 1

Я бы использовал буфер обмена и синхронизированные циклы.Существует возможность для повторного факторинга, который я сделаю позже.

На странице выполняется запрос POST xhr для результатов, поэтому используйте инструменты разработчика, которые вы сможете скопировать.Он использует этот URL: http://hydro.imd.gov.in/hydrometweb/(S(yir33wzdcp5kls450czjmh45))/DistrictRaifall.aspx. См. Комментарий в конце.

Option Explicit    
'VBE > Tools > References:
' Microsoft Internet Controls
Public Sub MakeSelections()
    Dim ie As InternetExplorer, commodity As String, iDate As String, clipboard As Object, arr()

    Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    Set ie = New InternetExplorer
    commodity = "MADHYA PRADESH"
    iDate = "REWA"

    With ie
        .Visible = True
        .Navigate2 "http://hydro.imd.gov.in/hydrometweb/(S(3qitcijd521egpzhwqq3jk55))/DistrictRaifall.aspx"

        While .Busy Or .readyState < 4: DoEvents: Wend

        .document.querySelector("[value='" & commodity & "']").Selected = True
        .document.querySelector("[name=listItems]").FireEvent "onchange"

        arr = ElementFound(.document, "[value='" & iDate & "']")

        If Not arr(0) Then Exit Sub

        arr(1).Selected = True
        .document.querySelector("#GoBtn").Click

        arr = ElementFound(.document, "#GridId")

        If Not arr(0) Then Exit Sub

        clipboard.SetText arr(1).outerHTML
        clipboard.PutInClipboard
        ThisWorkbook.Worksheets("Sheet1").Cells(1, 1).PasteSpecial
        .Quit
    End With
End Sub

Public Function ElementFound(ByRef document As Object, ByVal selector As String) As Variant
    Dim ele As Object, t As Date, arr(0 To 1)
    Const MAX_WAIT_SEC As Long = 5
    t = Timer
    Do
        On Error Resume Next
        Set ele = document.querySelector(selector)
        On Error GoTo 0
        If Timer - t > MAX_WAIT_SEC Then Exit Do
    Loop While ele Is Nothing
    If Not ele Is Nothing Then
        arr(0) = True
    Else
        arr(0) = False
    End If
    Set arr(1) = ele
    ElementFound = arr
End Function

---

XHR:

Тело POST включает параметры

__ EVENTTARGET:vbNullString

__ EVENTARGUMENT: vbNullString

__ LASTFOCUS: vbNullString

__ VIEWSTATE: будет получено.В моем случае, по крайней мере, получение этого из предыдущего GET не работало

__ VIEWSTATEGENERATOR: 6C290774 '<статическое, но его можно получить из предыдущего GET </p>

listItems: MADHYA PRADESH' замените пробелы на +

DistrictDropDownList: REWA

GoBtn: GO