Очистите данные, которых нет в исходном коде, используя VBA

#excel #vba #web-scraping

#excel #vba #очистка от веб-файлов

Вопрос:

Я пытаюсь очистить весь div с одного веб-сайта. Данные не видны в исходном коде, они изменяются на основе переменной в URL (ссылка).

Я искал какое-либо решение для копирования в таблицу Excel всего из

 <div id="div_measures_for_2103909010" class="measures_detail">

К сожалению, поскольку в прямом исходном коде нет данных, я нашел способ отображать только данные из div, предоставленного по ссылке выше

Однако, чтобы получить эти данные, мне сначала нужно было бы получить ссылку на прямые данные (ссылка находится в исходном коде).

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

Я пытался загрузить исходный код, выполнить поиск по ссылке, открыть ссылку и скопировать все данные, но у меня возникли проблемы с загрузкой исходного кода (Excel загружает только его часть из-за ограничений данных ячейки). Вот мой текущий код:

 Sub Open_Webpage()

Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
URL = "https://ec.europa.eu/taxation_customs/dds2/taric/measures.jsp?Lang=enamp;SimDate=20190329amp;Area=amp;MeasType=amp;StartPub=amp;EndPub=amp;MeasText=amp;GoodsText=amp;op=amp;Taric=2103909010amp;search_text=goodsamp;textSearch=amp;LangDescr=plamp;OrderNum=amp;Regulation=amp;measStartDat=amp;measEndDat="
objHTTP.Open "GET", URL, False
objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
objHTTP.send ("")
html = objHTTP.responseText
Range("A1").Value = html

End Sub

Если у меня есть полный код в одной ячейке, я могу затем найти ссылку в исходном коде и использовать ее:

 =MID(LEFT(A1,FIND("' width='100%'",A1)-1),FIND("' src='",A1) 7,LEN(A1))

Я знаю, что должно быть какое-то лучшее решение, но я не настолько хорошо разбираюсь в VBA, чтобы разобраться в этом…

1. split(split(a1," width='100%'")(1)," src=")(0) возможно, это способ поиска.

2. Я не могу разделить данные в A1, поскольку нет полного исходного кода, только его часть (та часть, которая содержит максимальное количество символов, которые могут быть сохранены в ячейке)

3. Вместо A1 используйте текст ответа

Ответ №1:

Вы можете регулярно выражать требуемый URL, выполнить небольшую очистку, а затем перейти к xhr. По какой-то причине я не смог просто использовать, getAttribute("onclick") поэтому пришлось использовать outerHTML ( innerHTML тоже нормально) для элемента

 Option Explicit
Public Sub GetInfo()
    Dim html As HTMLDocument, s As String, re As Object, url As String
    Set re = CreateObject("vbscript.regexp")
    Set html = New HTMLDocument                  '<  VBE > Tools > References > Microsoft Scripting Runtime
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://ec.europa.eu/taxation_customs/dds2/taric/measures.jsp?Lang=enamp;SimDate=20190329amp;Area=amp;MeasType=amp;StartPub=amp;EndPub=amp;MeasText=amp;GoodsText=amp;op=amp;Taric=2103909010amp;search_text=goodsamp;textSearch=amp;LangDescr=plamp;OrderNum=amp;Regulation=amp;measStartDat=amp;measEndDat=", False
        .send
        html.body.innerHTML = .responseText

        s = html.querySelector("[id$='_end_goods']").outerHTML
        With re
            .Global = True
            .MultiLine = True
            .IgnoreCase = True
            .Pattern = "measures_details.jsp(.*)');"
            If .Test(s) Then
                url = "https://ec.europa.eu/taxation_customs/dds2/taric/measures_details.jsp" amp; .Execute(s)(0).SubMatches(0)
                url = Replace$(url, "amp;amp;", "amp;")
            End If
        End With
        If Len(url) > 0 Then
            .Open "GET", url, False
            .send
            html.body.innerHTML = .responseText                
            ActiveSheet.Cells(1, 1) = html.querySelector(".measures_detail").innerText
        End If
    End With
End Sub

Попробуйте использовать регулярное выражение здесь

Ссылки:

VBE > Инструменты > Ссылки > Библиотека объектов Microsoft HTML