Доступ к таблице веб-сайта с помощью WinHTTPRequest в Excel VBA - PullRequest
0 голосов
/ 09 июня 2018

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

Проблема в том, что веб-сайт плохо работает с Internet Explorer, поэтому код успешно выполняется только примерно половину времени.Я мог бы написать процедуру, которая проверяет, успешно ли загружен веб-сайт, и повторять, если это не так, однако я хочу посмотреть, смогу ли я заставить его работать с WinHTTPRequest.таблица с использованием веб-проводника, основанного на Internet Explorer, с последней строкой, как я загружаю таблицу в переменную.

Set IE = CreateObject("InternetExplorer.Application")
IE.navigate "https://weather.com/weather/tenday/l/12345:4:US"
IE.Visible = True

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

Set doc = IE.document

Set WeatherTable = doc.getElementsByClassName("twc-table")(0)

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

Set doc = New HTMLDocument

With CreateObject("WINHTTP.WinHTTPRequest.5.1")
    .Open "GET", "https://weather.com/weather/tenday/l/12345:4:US", False
    .send
    doc.body.innerHTML = .responseText
End With

Однако, когда я пытаюсь захватить таблицу, используя строку ниже, я получаю «Ошибка времени выполнения '438': объект не поддерживает это свойство или метод.

Set WeatherTable = doc.getElementByclassname("twc-table")(0)

В основном мне нуженэквивалент этой строки для WinHTTP webscraping.

Я посмотрел, как спускался вниз по html-документу (doc.body.all.item (1) и т. д.), но я не очень далеко, прежде чем столкнутьсяЯ также посмотрел на аддон Selenium, но не помню, смог ли я успешно загрузить и установить его, и я не уверен, поддерживается ли он для текущей версии v.ersions of chrome / firefox.

Вот полный код, который позволяет мне получить таблицу с помощью веб-поиска в Internet Explorer, а затем поместить ее в таблицу Excel.

Любая помощь приветствуется.

Sub GetTable2()

Dim IE As Object
Dim doc As HTMLDocument
Dim WeatherTable As HTMLTable
Dim WeatherTableRows As HTMLTableRow
Dim HTMLTableCell As HTMLTableCell
Dim HeaderRow As Boolean

Dim RowCount As Long
Dim ColumnCount As Long

Dim i As Long

RowCount = 1
ColumnCount = 1
HeaderRow = True

Set IE = CreateObject("InternetExplorer.Application")
IE.navigate "https://weather.com/weather/tenday/l/12345:4:US"
IE.Visible = True

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

Set doc = IE.document

Set WeatherTable = doc.getElementsByClassName("twc-table")(0)

    For Each WeatherTableRows In WeatherTable.Rows
        i = 1
        For Each HTMLTableCell In WeatherTableRows.Cells
            If HeaderRow = True Then
                ThisWorkbook.Sheets("Sheet5").Cells(RowCount, ColumnCount).Value = HTMLTableCell.innerText
                ColumnCount = ColumnCount + 1
            Else
                If i = 1 Then
                    i = i + 1
                Else
                    ThisWorkbook.Sheets("Sheet5").Cells(RowCount, ColumnCount).Value = HTMLTableCell.innerText
                    ColumnCount = ColumnCount + 1
                End If
            End If
        Next HTMLTableCell
        HeaderRow = False
    ColumnCount = 1
    RowCount = RowCount + 1
    Next WeatherTableRows

IE.Quit
Set IE = Nothing
Set doc = Nothing

End Sub

Ответы [ 2 ]

0 голосов
/ 09 июня 2018

Чтобы сделать ваш подход немного чище, вы также можете попробовать этот способ.

Sub FetchTabularData()
    Dim elem As Object, trow As Object, S$, R&, C&

    [B1:G1] = [{"Day","Description","High/Low","Precip","Wind","Humidity"}]

    With New WinHttp.WinHttpRequest
        .Open "GET", "https://weather.com/weather/tenday/l/12345:4:US", False
        .send
        S = .responseText
    End With

    With New HTMLDocument
        .body.innerHTML = S

        For Each elem In .querySelector(".twc-table").getElementsByTagName("tr")
            For Each trow In elem.getElementsByTagName("td")
                C = C + 1: Cells(R + 1, C) = trow.innerText
            Next trow
            C = 0: R = R + 1
        Next elem
    End With
End Sub

Ссылка для добавления:

Microsoft HTML Object Library
Microsoft WinHTTP Services, version 5.1
0 голосов
/ 09 июня 2018

Вы пропустили s.Это множественное число, поскольку вы получаете коллекцию элемента s от className.

Set WeatherTable = doc.getElementsByClassName("twc-table")(0)
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...