Использование VBA для копирования нескольких таблиц HTML из браузера в Excel

Звучит просто, правда?

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

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

В любом случае, моя проблема в том, что я не могу получить информацию из некоторых ячеек, когда они содержат ссылки на другие страницы. Например, на этом сайте OPM, https://www.opm.gov/policy-data-oversight/pay-leave/salaries-wages/2017/general-schedule/, есть веб-опция для просмотра формы, и я не могу получить его, чтобы скопировать веб-адреса в Excel. Копирование текста в ячейки работает нормально, но я не могу понять, как заставить его копировать текст href.

У кого-нибудь есть опыт с этим, и можно надеяться, что он укажет мне правильное направление?

Лучший,

Невежественный Парень, который потерян как обычно.

Изменить: вот мой код до сих пор. Я удалил биты о href, потому что они заставляли его не работать и почти наверняка были неверными.

Sub GetTables () Dim doc As HTMLDocument Dim htmTable As HTMLTable Dim hpLink As IHTMLElement Dim data Dim x As Long, y As Long Dim oRow As Object, oCell As Object Dim oDom As Object: Set oDom = CreateObject ("htmlFile")

x = 1
y = 1
Set doc = New HTMLDocument
With CreateObject("MSXML2.XMLHTTP")
    .Open "GET", "https://www.opm.gov/policy-data-oversight/pay-leave/salaries-wages/2017/general-schedule/"
    .send
    Do: DoEvents: Loop Until .readyState = 4
    doc.body.innerHTML = .responseText
    .abort
End With

Set htmTable = doc.getElementsByClassName("DataTable")(0)

With htmTable
    Debug.Print .Rows(0).Cells(1).innerText
    Debug.Print .Rows(6).Cells(1).innerText
    Debug.Print .Rows(7).Cells(1).innerText

    ReDim data(1 To .Rows.Length, 1 To .Rows(1).Cells.Length)
    For Each oRow In .Rows
        For Each oCell In oRow.Cells

            data(x, y) = oCell.innerText
            'Previously, I had attempted to use oCell.href to get the value 
            'but that did not work.

            y = y + 1
        Next oCell
        y = 1
        x = x + 1
    Next oRow
End With

Sheets(1).Cells(1, 1).Resize(UBound(data), UBound(data, 2)).Value = data

End Sub

0 ответов

Другие вопросы по тегам