Использование 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