Использование объекта XMLHTTP для анализа некоторых веб-сайтов в VBA

Question

Я пытаюсь выбрать поле "ключевые люди" со страницы Википедии: https://en.wikipedia.org/wiki/Abbott_Laboratories и скопировать это значение в свою электронную таблицу Excel.

Мне удалось сделать это с помощью xml httpэтот метод мне нравится из-за его скорости, вы можете увидеть код, который работает ниже.

Код, однако, недостаточно гибок, так как структура страницы вики может измениться, например, он не работаетна этой странице: https://en.wikipedia.org/wiki/3M

, поскольку структура tr td не совпадает (ключевые люди больше не являются 8-ми TR для страницы 3M)

Как я могу улучшить свой код?

Public Sub parsehtml()

Dim http As Object, html As New HTMLDocument, topics As Object, titleElem As Object, detailsElem As Object, topic As HTMLHtmlElement
Dim i As Integer

Set http = CreateObject("MSXML2.XMLHTTP")



http.Open "GET", "https://en.wikipedia.org/wiki/Abbott_Laboratories", False

http.send

html.body.innerHTML = http.responseText

Set topic = html.getElementsByTagName("tr")(8)

Set titleElem = topic.getElementsByTagName("td")(0)

ThisWorkbook.Sheets(1).Cells(1, 1).Value = titleElem.innerText

End Sub

Answer 1

Если строка таблицы не является фиксированной для «Ключевых людей», то почему бы не зациклить таблицу для «Ключевых людей»

Я проверил со следующей модификацией, она работает правильно.

В разделе объявления

Dim topics As HTMLTable, Rw As HTMLTableRow

и, наконец,

html.body.innerHTML = http.responseText
Set topic = html.getElementsByClassName("infobox vcard")(0)

    For Each Rw In topic.Rows
        If Rw.Cells(0).innerText = "Key people" Then
        ThisWorkbook.Sheets(1).Cells(1, 1).Value = Rw.Cells(1).innerText
        Exit For
        End If
    Next

Answer 2

Есть лучший способ быстрее. По крайней мере для данных URL. Совпадение по имени класса элемента и индекса в возвращенном nodeList. Меньше возвращаемых элементов для обработки, путь к элементу короче, а сопоставление с именем класса быстрее, чем сопоставление по типу элемента.

Option Explicit
Public Sub GetKeyPeople()
    Dim html As HTMLDocument, body As String, urls(), i As Long, keyPeople
    Set html = New HTMLDocument
    urls = Array("https://en.wikipedia.org/wiki/Abbott_Laboratories", "https://en.wikipedia.org/wiki/3M")
    With CreateObject("MSXML2.XMLHTTP")
        For i = LBound(urls) To UBound(urls)
            .Open "GET", urls(i), False
            .send
            html.body.innerHTML = .responseText
            keyPeople = html.querySelectorAll(".agent").item(1).innerText
            ThisWorkbook.Worksheets("Sheet1").Cells(i + 1, 1).Value = keyPeople
        Next
    End With
End Sub