使用VBA刮取源代码中没有的数据

Question

我试图从一个网站上刮掉整个div。数据在源代码中不可见，它根据URL中的变量（link）而变化。

我正在寻找任何解决方案，以复制到excel表中的所有内容

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

不幸的是，由于直接源代码中没有数据，我找到了一种只显示上面提供的数据的方法Link

但是要获得这些数据，我首先需要获得直接数据的链接（链接在源代码中）。

你知道如何以最好的方式处理它吗？

我已经尝试下载源代码，搜索链接，打开链接并复制所有数据，但是我在下载源代码时遇到了麻烦（由于单元格数据的限制，excel仅下载部分内容）。这是我目前的代码：

Sub Open_Webpage()

Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
URL = "https://ec.europa.eu/taxation_customs/dds2/taric/measures.jsp?Lang=en&SimDate=20190329&Area=&MeasType=&StartPub=&EndPub=&MeasText=&GoodsText=&op=&Taric=2103909010&search_text=goods&textSearch=&LangDescr=pl&OrderNum=&Regulation=&measStartDat=&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来弄明白......

Answer 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=en&SimDate=20190329&Area=&MeasType=&StartPub=&EndPub=&MeasText=&GoodsText=&op=&Taric=2103909010&search_text=goods&textSearch=&LangDescr=pl&OrderNum=&Regulation=&measStartDat=&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" & .Execute(s)(0).SubMatches(0)
                url = Replace$(url, "&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

试试正则表达式here

---

参考文献：

1. VBE>工具>参考> Microsoft HTML对象库