在 VBA 中解析 HTML 内容答案

【问题标题】：Parse HTML content in VBA在 VBA 中解析 HTML 内容
【发布时间】：2014-10-18 18:25:12
【问题描述】：

我有一个关于 HTML 解析的问题。我有一个包含一些产品的网站，我想将页面内的文本捕获到我当前的电子表格中。这个电子表格很大，但在第 3 列中包含 ItemNbr，我希望第 14 列中的文本和一行对应一个产品（项目）。

我的想法是在标签后的 Innertext 内的网页上获取“材料”。 id 编号从一页到另一页（有时）变化。

这是网站的结构：

<div style="position:relative;">
    <div></div>
    <table id="list-table" width="100%" tabindex="1" cellspacing="0" cellpadding="0" border="0" role="grid" aria-multiselectable="false" aria-labelledby="gbox_list-table" class="ui-jqgrid-btable" style="width: 930px;">
        <tbody>
            <tr class="jqgfirstrow" role="row" style="height:auto">
                <td ...</td>
                <td ...</td>
            </tr>
            <tr role="row" id="1" tabindex="-1" class="ui-widget-content jqgrow ui-row-ltr">
                <td ...</td>
                <td ...</td>
            </tr>
            <tr role="row" id="2" tabindex="-1" class="ui-widget-content jqgrow ui-row-ltr">
                <td ...</td>
                <td ...</td>
            </tr>
            <tr role="row" id="3" tabindex="-1" class="ui-widget-content jqgrow ui-row-ltr">
                <td ...</td>
                <td ...</td>
            </tr>
            <tr role="row" id="4" tabindex="-1" class="ui-widget-content jqgrow ui-row-ltr">
                <td ...</td>
                <td ...</td>
            </tr>
            <tr role="row" id="5" tabindex="-1" class="ui-widget-content jqgrow ui-row-ltr">
                <td ...</td>
                <td ...</td>
            </tr>
            <tr role="row" id="6" tabindex="-1" class="ui-widget-content jqgrow ui-row-ltr">
                <td ...</td>
                <td ...</td>
            </tr>
            <tr role="row" id="7" tabindex="-1" class="ui-widget-content jqgrow ui-row-ltr">
                <td role="gridcell" style="padding-left:10px" title="Material" aria-describedby="list-table_">Material</td>
                <td role="gridcell" style="" title="600D polyester." aria-describedby="list-table_">600D polyester.</td>
            </tr>           
            <tr ...>
            </tr>
        </tbody>
    </table> </div>

结果我想得到“600D 涤纶”。

我的（不工作的）代码 sn-p 原样：

Sub ParseMaterial()

    Dim Cell As Integer
    Dim ItemNbr As String

    Dim AElement As Object
    Dim AElements As IHTMLElementCollection
Dim IE As MSXML2.XMLHTTP60
Set IE = New MSXML2.XMLHTTP60

Dim HTMLDoc As MSHTML.HTMLDocument
Dim HTMLBody As MSHTML.HTMLBody

Set HTMLDoc = New MSHTML.HTMLDocument
Set HTMLBody = HTMLDoc.body

For Cell = 1 To 5                            'I iterate through the file row by row

    ItemNbr = Cells(Cell, 3).Value           'ItemNbr isin the 3rd Column of my spreadsheet

    IE.Open "GET", "http://www.example.com/?item=" & ItemNbr, False
    IE.send

    While IE.ReadyState <> 4
        DoEvents
    Wend

    HTMLBody.innerHTML = IE.responseText

    Set AElements = HTMLDoc.getElementById("list-table").getElementsByTagName("tr")
    For Each AElement In AElements
        If AElement.Title = "Material" Then
            Cells(Cell, 14) = AElement.nextNode.value     'I write the material in the 14th column
        End If
    Next AElement

        Application.Wait (Now + TimeValue("0:00:2"))

Next Cell

感谢您的帮助！

【问题讨论】：

标签： vba parsing excel html-parsing web-crawler

【解决方案1】：

希望你能找到正确的方向：

清理一下：删除 readystate 属性测试循环。在此上下文中，readystate 属性返回的值永远不会改变 - 代码将在发送指令后暂停，仅在收到服务器响应或未能这样做时恢复。将相应地设置 readystate 属性，并且代码将恢复执行。您仍然应该测试就绪状态，但循环是不必要的
定位正确的 HTML 元素：您正在搜索 tr 元素 - 而您在代码中如何使用这些元素的逻辑实际上看起来指向 td 元素
确保属性实际上可用于您使用它们的对象：为了帮助您解决此问题，请尝试将所有变量声明为特定对象而不是通用对象。这将激活智能感知。如果您首先很难找到相关库中定义的对象的实际名称，请将其声明为通用对象，运行您的代码，然后检查对象的类型 - 通过打印 typename(your_object)例如调试窗口。这应该会让你上路

我还在下面包含了一些可能会有所帮助的代码。如果你仍然不能让它工作，你可以分享你的网址 - 请这样做。

Sub getInfoWeb()

    Dim cell As Integer
    Dim xhr As MSXML2.XMLHTTP60
    Dim doc As MSHTML.HTMLDocument
    Dim table As MSHTML.HTMLTable
    Dim tableCells As MSHTML.IHTMLElementCollection
    
    Set xhr = New MSXML2.XMLHTTP60
   
    For cell = 1 To 5
        
        ItemNbr = Cells(cell, 3).Value
        
        With xhr
        
            .Open "GET", "http://www.example.com/?item=" & ItemNbr, False
            .send
            
            If .readyState = 4 And .Status = 200 Then
                Set doc = New MSHTML.HTMLDocument
                doc.body.innerHTML = .responseText
            Else
                MsgBox "Error" & vbNewLine & "Ready state: " & .readyState & _
                vbNewLine & "HTTP request status: " & .Status
            End If
            
        End With
        
        Set table = doc.getElementById("list-table")
        Set tableCells = table.getElementsByTagName("td")
        
        For Each tableCell In tableCells
            If tableCell.getAttribute("title") = "Material" Then
                Cells(cell, 14).Value = tableCell.NextSibling.innerHTML
            End If
        Next tableCell
    
    Next cell
    
End Sub

编辑：作为您在下面的评论中提供的进一步信息的后续行动 - 以及我添加的其他 cmets

'Determine your product number
    'Open an xhr for your source url, and retrieve the product number from there - search for the tag which
    'text include the "productnummer:" substring, and extract the product number from the outerstring
    'OR
    'if the product number consistently consists of the fctkeywords you are entering in your source url
    'with two "0" appended - just build the product number like that
'Open an new xhr for this url "http://www.pfconcept.com/cgi-bin/wspd_pcdb_cgi.sh/y/y2productspec-ajax.p?itemc=" & product_number & "&_search=false&rows=-1&page=1&sidx=&sord=asc"
'Load the response in an XML document, and retrieve the material information

Sub getInfoWeb()

    Dim xhr As MSXML2.XMLHTTP60
    Dim doc As MSXML2.DOMDocument60
    Dim xmlCell As MSXML2.IXMLDOMElement
    Dim xmlCells As MSXML2.IXMLDOMNodeList
    Dim materialValueElement As MSXML2.IXMLDOMElement
    
    Set xhr = New MSXML2.XMLHTTP60
        
        With xhr
            
            .Open "GET", "http://www.pfconcept.com/cgi-bin/wspd_pcdb_cgi.sh/y/y2productspec-ajax.p?itemc=10031700&_search=false&rows=-1&page=1&sidx=&sord=asc", False
            .send
            
            If .readyState = 4 And .Status = 200 Then
                Set doc = New MSXML2.DOMDocument60
                doc.LoadXML .responseText
            Else
                MsgBox "Error" & vbNewLine & "Ready state: " & .readyState & _
                vbNewLine & "HTTP request status: " & .Status
            End If
            
        End With
        
        Set xmlCells = doc.getElementsByTagName("cell")

        For Each xmlCell In xmlCells
            If xmlCell.Text = "Materiaal" Then
                Set materialValueElement = xmlCell.NextSibling
            End If
        Next
        
        MsgBox materialValueElement.Text
    
End Sub

EDIT2：另一种自动化 IE

Sub searchWebViaIE()
    Dim ie As SHDocVw.InternetExplorer
    Dim doc As MSHTML.HTMLDocument
    Dim anchors As MSHTML.IHTMLElementCollection
    Dim anchor As MSHTML.HTMLAnchorElement
    Dim prodSpec As MSHTML.HTMLAnchorElement
    Dim tableCells As MSHTML.IHTMLElementCollection
    Dim materialValueElement As MSHTML.HTMLTableCell
    Dim tableCell As MSHTML.HTMLTableCell
    
    Set ie = New SHDocVw.InternetExplorer
    
    With ie
        .navigate "http://www.pfconcept.com/cgi-bin/wspd_pcdb_cgi.sh/y/y2facetmain.p?fctkeywords=100317&world=general#tabs-4"
        .Visible = True
        
        Do While .readyState <> READYSTATE_COMPLETE Or .Busy = True
            DoEvents
        Loop
        
        Set doc = .document
        
        Set anchors = doc.getElementsByTagName("a")
        
        For Each anchor In anchors
            If InStr(anchor.innerHTML, "Product Specificatie") <> 0 Then
                anchor.Click
                Exit For
            End If
        Next anchor
        
        Do While .readyState <> READYSTATE_COMPLETE Or .Busy = True
            DoEvents
        Loop
    
    End With
        
    For Each anchor In anchors
        If InStr(anchor.innerHTML, "Product Specificatie") <> 0 Then
            Set prodSpec = anchor
        End If
    Next anchor
    
    Set tableCells = doc.getElementById("list-table").getElementsByTagName("td")
    
    If Not tableCells Is Nothing Then
        For Each tableCell In tableCells
            If tableCell.innerHTML = "Materiaal" Then
                Set materialValueElement = tableCell.NextSibling
            End If
        Next tableCell
    End If
    
    MsgBox materialValueElement.innerHTML
    
End Sub

【讨论】：

再次感谢您的回答 IAmDranged！不幸的是，这一次它没有提供预期的输出。这是考虑的具有特定产品的网站：pfconcept.com/cgi-bin/wspd_pcdb_cgi.sh/y/… 这些错误发生：*“未设置对象变量（错误 91）”在“设置 tableCells = table.getElementsByTagName（“td”）”行*“类型不匹配（错误13)”在“For Each tableCell In tds”行，我试图用“doc”替换“table.getElementsByName(“td”)”。和'tableCells'的'tds'。然后它运行没有错误，但没有任何反应。
这是因为该表在 html 源中不存在 - 所以表返回 Nothing。当 url 加载到浏览器中时，该表实际上被请求并作为备用 xml 文档返回 - 在您在上面 pfconcept.com/cgi-bin/wspd_pcdb_cgi.sh/y/… 上使用的特定示例中，该表将来自该 url。这个 url 看起来需要一个产品 ID、标准参数和一个看似多余的“nd”参数。您可以使用适当的参数而不是源 url 来定位此 url
我在上面添加了更多代码来举例说明如何解决问题 - 希望这会有所帮助
完美运行！我试图触发“Onclick”事件但没有成功。我没有注意到网站可以这样打开。非常感谢 IAmDranged！
没问题。为了能够正确管理 Onclick 事件，您需要在适当的环境中工作 - 例如类似浏览器的环境。例如，您可以通过自动化 IE 来做到这一点 - 我添加了更多代码来展示如何做到这一点

【解决方案2】：

与表格或 Excel 无关（我使用 MS-Access 2013），但与主题标题直接相关。我的解决方案是

Private Sub Sample(urlSource)
Dim httpRequest As New WinHttpRequest
Dim doc As MSHTML.HTMLDocument
Dim tags As MSHTML.IHTMLElementCollection
Dim tag As MSHTML.HTMLHtmlElement
httpRequest.Option(WinHttpRequestOption_UserAgentString) = "Mozilla/4.0 (compatible;MSIE 7.0; Windows NT 6.0)"
httpRequest.Open "GET", urlSource
httpRequest.send ' fetching webpage
Set doc = New MSHTML.HTMLDocument
doc.body.innerHTML = httpRequest.responseText
Set tags = doc.getElementsByTagName("a")
i = 1
For Each tag In tags
  Debug.Print i
  Debug.Print tag.href
  Debug.Print tag.innerText
  'Debug.Print tag.Attributes("any other attributes you need")() ' may return an object
  i = i + 1
  If i Mod 50 = 0 Then Stop
  ' or code to store results in a table
Next
End Sub

【讨论】：