VBA, Парсинг - Поиск информации на web-странице и вставка результата в ячейку

Пользователь

Сообщений: 1 Регистрация: 25.05.2020

25.05.2020 13:31:25

Ребята, привет.

Помогите разобраться. Сразу оговорюсь у меня низкий уровень владения VBA.
Требуется собрать с HTML страниц информацию и внести в таблицу. Ссылка на страницы отличается номером страницы, номер страницы с которой необходимо собрать информацию содержится в ячейках с A2 до An, где n - это значение в ячейке B2
Искомая информация на странице имеет вид:
<span class="custom" id="label">
<a class="header@
target="_blank" Shape ="">Искомое значение</a>
Нужно Искомое значение с каждой страницы забить в ячейки с B2 до Bn.

Вот такую штуку я нафантазировал)

Sub Graber()
set XSheet = ThisWorkbook.Sheets(1)
set XWeb = CreateObject("InternetExplorer.Aplication")
set XNumber = XSheet.Cells(1, B)
For i = "Тут не понятно, нужно от ячейки A2 до ячейки A(XNumber)"
XCValue = Cells(i, "A")
link = "http://" & XCValue
XWeb.navigate link
While XWeb.busy Or (XWeb.readystate <> 4): DoEvents: Wend
getHTML = XWeb.document.body.innerHTML
dl = Len(getHTML)
a = InStr(na, getHTML, "id="label")
If a > 0 Then
XCR = XSheet.Cells(Rows.Count, 1).End(x1Up).Row
rn = InStr(a, getHTML, ">")
rk = InStr(rn, getHTML, "</a>")
rrn = Mid(getHTML, rn + 1, rk - rn - 1)
XSheet.Cells(XCR + 1, "B") = rrn
End

Изменено: MikeOzeman - 25.05.2020 13:47:10

Игорь

Пользователь

Сообщений: 3679 Регистрация: 23.12.2012

25.05.2020 13:49:41

Я бы примерно так написал:

Код

Sub Graber()
    Dim cell As Range
    For Each cell In Range("a2:a" & [B1]).Cells
        txt = GetHTTPResponse("http://" & cell)
        
        span = GetTags(txt, "span", "id", "label", "innerHTML 1")
        linkText = GetTags(span, "a", "", "", "ConvertToText 1")
        
        cell.Next = linkText
    Next cell
End Sub

Тут можно найти функцию VBA для извлечения тегов из HTML
https://excelvba.ru/code/html
а для скачивания - здесь:
https://excelvba.ru/code/GetHTTPResponse