Получение текстового содержимого из таблицы HTML без идентификатора с помощью VBA

Question

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

Отредактировано Здесь вы можете увидеть изображение файла Excel. Номера GTIP расположены в столбце A. Моя цель - при запуске кода VBA эти номера GTIP из столбца A перенаправляются в поле поиска с именем «GTİP Ara» на веб-сайте https://www.isib.gov.tr/urun-arama/. В результате компании, имеющие выбранный GTIP, будут возвращены в столбцы следующей указанной строки.

Для третьей строки номер GTIP "841013000000" был переадресован в поле поиска с именем GTIP Ara и в результате; Компания 2, ... Компания 9 возвращается в соседние столбцы.

Иногда номера GTIP ничего не возвращают, поскольку ни одна из компаний не имеет указанного номера.

Например: 841410819000 вернет компании, но 841112101000 вернет ошибку «Aradığınız Sonuç Bulunamadı!». Вот почему я пытаюсь добавить оператор if, но он не работает должным образом.

Теперь из-за ошибки где-то в моем блоке кода; возвращенные значения одинаковы для каждого GTIP, здесь вы можете увидеть результат на втором изображении.

Sub GrabLastNames () Dim obj IE как InternetExplorer Dim ele как объект Dim y как целое число

Set objIE = New InternetExplorer

objIE.Visible = True

objIE.navigate "https://www.isib.gov.tr/urun-arama"

Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop

y = 2

For i = 2 To 269
    objIE.document.getElementById("gtip-ara").Value = _
Sheets("Sheet1").Range("A:A").Cells(i, 1).Value
    objIE.document.getElementById("ara").Click
    'If objIE.document.getElementsByClassName("error").getElementsByTagName("span").Value <> "Aradığınız Sonuç Bulunamadı!" Then
        For Each ele In objIE.document.getElementsByClassName("urun-arama-table table")(0).getElementsByTagName("tbody")(0).getElementsByTagName("tr")
        Sheets("Sheet1").Cells(i, y).Value = ele.Children(0).textContent
        y = y + 1
            Next
            y = 2
            Next i

End Sub

Answer 1

У меня был только один рабочий GTIP 841410819000, поэтому я не могу проверить это более тщательно.

Вам на самом деле не нужно знать идентификатор, на странице есть одна таблица, поэтому получить его, используя getElemenetsByClassName, как вы это сделали, или просто getElementsByTagName, как в моем примере, должно работать нормально. Мой код, вероятно, такой же, как и у вас, только с несколькими паузами: a: не спамить на сайте и b: дать IE шанс собраться (в конце концов IE).

Если вы можете предоставить еще несколько рабочих значений GTIP, я могу протестировать немного больше.

' requires reference 'Microft HTML Object Library'
Sub Main()

Dim Browser As New InternetExplorer

Browser.Visible = True

Browser.navigate "https://www.isib.gov.tr/urun-arama"

Do While Browser.Busy And Not Browser.readyState = READYSTATE_COMPLETE
    DoEvents
Loop

Dim Sheet As Worksheet: Set Sheet = ThisWorkbook.Worksheets("Sheet1")

Dim TableRows As IHTMLElementCollection
Dim TableRow As IHTMLElement

Dim SourceRow As Integer
Dim ResultColumn As Integer

Application.Wait (Now + TimeValue("0:00:05"))

SourceRow = 2 ' Skip Header

Do
    Debug.Print "Trying " & Sheet.Cells(SourceRow, 1).Value
    Browser.Document.getElementById("gtip-ara").Value = Sheet.Cells(SourceRow, 1).Value
    Browser.Document.getElementById("ara").Click

    Application.Wait (Now + TimeValue("0:00:02"))

    Do While Browser.Busy
        DoEvents
    Loop

    If Browser.Document.getElementsByTagName("table").Length > 0 Then

        Debug.Print " > Found Results"

        Set TableRows = Browser.Document.getElementsByTagName("table")(0).getElementsByTagName("tbody")(0).getElementsByTagName("tr")

        ResultColumn = 2 ' dont overwrite search term

        For Each TableRow In TableRows
            Sheet.Cells(SourceRow, ResultColumn).Value = TableRow.innerText
            ResultColumn = ResultColumn + 1
        Next TableRow

    Else

        Debug.Print " - No Results Found"

    End If

    If Sheet.Cells(SourceRow + 1, 1).Value = "" Then
        Exit Do
    Else
        SourceRow = SourceRow + 1
    End If

    Application.Wait (Now + TimeValue("0:00:05"))

Loop

Browser.Quit
Set Browser = Nothing

End Sub

Обновление Обновил мой код снова, он больше не порождает множество windows и печатает только название компании (как это сделал ваш пример).

' requires Microsoft HTML Object Library
' requires Microsoft XML, v6.0
Sub Main()
Dim XHR As XMLHTTP60

Dim Document As HTMLDocument
Dim ResultRows As IHTMLElementCollection
Dim ResultRow As IHTMLElement

Dim Sheet As Worksheet: Set Sheet = ThisWorkbook.Worksheets("Sheet1")
Dim SheetRow As Integer
Dim SheetColumn As Integer

Dim LastRow As Integer

LastRow = Sheet.Cells(Sheet.Rows.Count, "A").End(xlUp).Row

For SheetRow = 2 To LastRow

    Debug.Print "Trying GTIP:" & Sheet.Cells(SheetRow, 1).Value

    Application.StatusBar = "Status: " & Right(String(Len(CStr(LastRow - 1)), "0") & CStr(SheetRow - 1), Len(CStr(LastRow - 1))) & "/" & CStr(LastRow - 1)

    Set XHR = New XMLHTTP60
    XHR.Open "POST", "https://www.isib.gov.tr/urun-arama", False
    XHR.setRequestHeader "content-type", "application/x-www-form-urlencoded"
    XHR.send "gtipkategori=" & Sheet.Cells(SheetRow, 1).Value

    Set Document = New HTMLDocument

    Document.body.innerHTML = XHR.responseText

    If Document.getElementsByTagName("table").Length > 0 Then
        Debug.Print " > Found Results"
        SheetColumn = 2 ' First Column to output data into
        Set ResultRows = Document.getElementsByTagName("table")(0).getElementsByTagName("tbody")(0).getElementsByTagName("tr")

        For Each ResultRow In ResultRows
            Sheet.Cells(SheetRow, SheetColumn).Value = ResultRow.getElementsByTagName("td")(0).innerText ' 0 - company name
            SheetColumn = SheetColumn + 1
        Next

    Else
        Debug.Print " - No Results"
    End If

    Set XHR = Nothing
    Set Document = Nothing

    Application.Wait (Now + TimeValue("0:00:01")) ' slow down requests

Next

Application.StatusBar = "Complete"

End Sub