VBA парсинг и импорт в столбец excel
Формулировка задачи:
Всем привет.
Решил сделать парсинг сайта: https://2gis.ru/ekaterinburg/rubrics
На данный момент реализовал простой вариант: Записываю в Textbox название рубрики, он открывает сайт, подставляет значение и нажимает кнопку поиск. ТУт я бы хотел автоматизовать работу, чтоб он изначально предлогал мне в виде выпадающего текста выбрать список рубрик (Combobox1), а в поле подрубрик (Combobox2) подгружались подрубрики
Решил поступить так: Спарсить страницу, взять значение всех тегов стоящих между (не получается):
<a class="link _scheme_none rubricsList__listItemLinkTitle"> и </a>
Занести их в столбец (например начиная с B1), ну а потом при клике на Combobox1 выйдет список данных элементов (Это я знаю как реализовать)
Вопрос помогите реализовать:
взять значение всех тегов стоящих между (https://2gis.ru/ekaterinburg/rubrics):
<a class="link _scheme_none rubricsList__listItemLinkTitle"> и </a>
Занести их в столбец (например начиная с B1),
Решение задачи: «VBA парсинг и импорт в столбец excel»
textual
Листинг программы
Const mUrl As String = "https://2gis.ru"
Const rUrl As String = "https://2gis.ru/ekaterinburg/rubrics"
Const srUrl As String = "https://2gis.ru/ekaterinburg/subrubrics/"
Sub uuu()
Dim a()
'------------
a = GetRubrics(rUrl)
End Sub
Function GetRubrics(ByVal url As String) As Variant
Dim a()
Dim i&
Dim t_li, t_a
'---------------------
Set sd = CreateObject("Scripting.Dictionary")
With CreateObject("HtmlFile")
.Body.innerHTML = GetHtml(url)
For Each t_li In .GetElementsByTagName("li")
If t_li.ClassName = "rubricsList__listItem" Then
i = i + 1
ReDim Preserve a(1 To 3, 1 To i)
a(1, i) = t_li.GetAttribute("data-name")
a(2, i) = t_li.GetAttribute("data-id")
a(3, i) = srUrl & a(2, i)
End If
Next
End With
GetRubrics = Application.Transpose(a)
End Function
Function GetHtml(ByVal url As String) As String
With CreateObject("msxml2.xmlhttp")
.Open "GET", url, False
.send
Do: DoEvents: Loop Until .ReadyState = 4
GetHtml = .responsetext
End With
End Function