通过 VBA/Excel 提取 HTML

Question

我在 17track.net 上有以下 HTML 代码：

 <div class="tools"> <button type="button" class="btn btn-sm icon fa-copy-files-o waves- 
effect" data-toggle="tooltip" data-placement="top" data-original-title="Copy detailed 
 tracking results for all numbers." id="cl-details" data-clipboard-text="Number: 
 LW571320552CN
 Package status: Delivered (26 Days)
 Country: China -> United States
 Destination:
 2020-04-02 13:03, CATAWBA, SC 29704, Delivered, In/At Mailbox -> Your item was delivered in 
 or at the mailbox at 1:03 pm on April 2, 2020 in CATAWBA, SC 29704.
 2020-04-02 08:13, CATAWBA, SC 29704, Out for Delivery
 2020-04-02 08:02, CATAWBA, SC 29704, Arrived at Unit
 2020-04-01 10:59, MID CAROLINA-CHARLOTTE NC DISTRIBUTION CENTER, Arrived at USPS Regional 
 Destination Facility
 2020-03-31 00:00, In Transit to Next Facility
 2020-03-30 10:02, ALBANY NY DISTRIBUTION CENTER, Arrived at USPS Regional Facility
 2020-03-28 09:54, ISC NEW YORK NY(USPS), Processed Through Facility
 2020-03-28 09:54, Origin Post is Preparing Shipment

实际上，我只需要获取包裹状态。我也可以将整个文本粘贴到excel中，然后我可以用VBA解析它。出于某种原因，我的 VBA 代码无法通过简单的抓取来检索它。我是 HTML 新手，所以感谢您的帮助。

 Sub TrackData()

 Dim element As IHTMLElement
 Dim elements As IHTMLElementCollection
 Dim ie As InternetExplorer

 Dim html As HTMLDocument



 Set ie = New InternetExplorer

 ie.Visible = True
 ie.navigate "https://t.17track.net/en#nums=LW572098229CN"

 'Wait until IE has loaded the web page

 Do While ie.readyState <> READYSTATE_COMPLETE


 DoEvents

 Loop

 Set html = ie.document

 Set elements = html.getElementsByClassName("tools")

 Dim count As Long
 Dim erow As Long
 count = 0
 For Each element In elements
 If element.Children = "Package Status:" Then
 Sheets("Stage").Cells(1, 1) = "Found It"
 End If
 Next element



 End Sub

Answer 1

您要搜索的值是属性值的一部分；这意味着，您需要检查该字符串的 .OuterHTML 或特定属性 data-clipboard-text 值。您不需要在多个节点上进行循环。您可以使用 id 专门针对该节点。我还将属性名称添加到节点选择中，以确保该属性存在，而无需在节点上进行hasAttribute 检查。我还会添加一个小暂停，以确保页面有时间动态检索内容并检查是否确实找到了节点。

Option Explicit

Public Sub CheckForPackageStatus()

    Dim ie As New SHDocVw.InternetExplorer

    Set ie = New SHDocVw.InternetExplorer

    With ie

        .Visible = True
        .Navigate2 "https://t.17track.net/en#nums=LW572098229CN"

        Do: DoEvents: Loop While .Busy Or .ReadyState <> READYSTATE_COMPLETE

        Application.Wait Now + TimeSerial(0, 0, 1)

        Dim node As Object

        Set node = .Document.querySelector("#cl-details[data-clipboard-text]")

        If Not node Is Nothing Then
                If InStr(node.getattribute("data-clipboard-text"), "Package status:") > 0 Then
                    ActiveSheet.Cells(1, 1) = "Found it"
                End If
        End If
    End With
End Sub