xml - 从xml查询到excel。类似于 Google 电子表格上的 importxml

Question

我正在尝试使用类似于 Google 电子表格的 importxml 的 excel 函数。

这是代码:

Function GetData(sURL As String, sItem As String) As Variant
Dim oHttp As New MSXML2.XMLHTTP60
Dim xmlResp As MSXML2.DOMDocument60
Dim result As Variant
On Error GoTo EH



'open the request and send it
oHttp.Open "GET", sURL, False
oHttp.Send

'get the response as xml
Set xmlResp = oHttp.responseXML
' get Item
GetData = xmlResp.SelectNodes(sItem).Item(0).Text

' Examine output of these in the Immediate window
Debug.Print sName
Debug.Print xmlResp.XML

CleanUp:
On Error Resume Next
Set xmlResp = Nothing
Set oHttp = Nothing
Exit Function
EH:
GetData = CVErr(xlErrValue)
GoTo CleanUp
End Function

以下公式将返回 192799976.00

=GetData("http://api.eve-central.com/api/marketstat?typeid=24692&usesystem=30000142","//sell/min")

这个公式将返回 34

=GetData("http://util.eveuniversity.org/xml/itemLookup.php?name=Tritanium","//itemLookup/typeID")

我得到了#VALUE!当试图从这个网站提取数据时，它应该是 179 美元。

    =GetData("http://www.hotels.com/hotel/details.html?current-location=Chicago%2C+Illinois%2C+United+States+of+America&arrivalDate=10%2F30%2F14&departureDate=10%2F31%2F14&searchParams.rooms.compact_occupancy_dropdown=compact_occupancy_1_2&rooms_=1&rooms%5B0%5D.numberOfAdults=2&children%5B0%5D=0&searchParams.landmark=&hotelId=113158&roomno=1&srsReport=HomePage%7CAutoR%7CHOTEL%7Cthe++drake+Chicago%2C+Illinois%2C+United+States+of+America%7C0%7C0%7C0%7C1%7C1%7C1%7C113158&resolvedLocation=HOTEL%3A113158%3ASRS%3AUNKNOWN&pageName=HomePage&destinationId=&rooms.compact_occupancy_dropdown=compact_occupancy_1_2&landmark=
","//span/strong")

编辑 1:试图将 @portlandrunner 的 sub 变成一个函数，但 excel 表示该函数无效。

 Function extract(URL As String) As Variant
    Dim IE As InternetExplorer
    Dim html As HTMLDocument

    Set IE = New InternetExplorerMedium
    IE.Visible = False
    IE.Navigate2 URL

    ' Wait while IE loading
    Do While IE.Busy
        Application.Wait DateAdd("s", 1, Now)
    Loop

    Set html = IE.Document
    Set spanElement = html.getElementsByTagName("span")

    For Each spn In spanElement
        If Left(spn.innertext, 1) = "$" Then
            extract = spn.innertext
            Exit For
        End If
    Next spn

    'Cleanup
    IE.Quit
    Set IE = Nothing    
End Function

Answer 1

最后一个示例中的 URL 仅返回 HTML不是 XML .

您可以使用 IE 文档通过标签或类名获取 HTML 元素。以下代码将显示第一个 <span>带有 $ 的标签，即 $179。

确保你:

添加了对“Microsoft Internet Controls”的引用

添加了对“Microsoft HTML 对象库”的引用

根据您的 IE 版本，您可能需要在 IE 互联网选项菜单的安全设置下禁用保护模式。

Sub extract()
    Dim IE As InternetExplorer
    Dim html As HTMLDocument

    Set IE = New InternetExplorerMedium
    IE.Visible = False
    IE.Navigate2 "http://www.hotels.com/hotel/details.html?current-location=Chicago%2C+Illinois%2C+United+States+of+America&arrivalDate=10%2F30%2F14&departureDate=10%2F31%2F14&searchParams.rooms.compact_occupancy_dropdown=compact_occupancy_1_2&rooms_=1&rooms%5B0%5D.numberOfAdults=2&children%5B0%5D=0&searchParams.landmark=&hotelId=113158&roomno=1&srsReport=HomePage%7CAutoR%7CHOTEL%7Cthe++drake+Chicago%2C+Illinois%2C+United+States+of+America%7C0%7C0%7C0%7C1%7C1%7C1%7C113158&resolvedLocation=HOTEL%3A113158%3ASRS%3AUNKNOWN&pageName=HomePage&destinationId=&rooms.compact_occupancy_dropdown=compact_occupancy_1_2&landmark="

    ' Wait while IE loading
    Do While IE.Busy
        Application.Wait DateAdd("s", 1, Now)
    Loop

    Set html = IE.Document
    Set spanElement = html.getElementsByTagName("span")

    For Each spn In spanElement
        If Left(spn.innertext, 1) = "$" Then
            MsgBox spn.innertext
            Exit For
        End If
    Next spn

    'Cleanup
    IE.Quit
    Set IE = Nothing
End Sub

经过测试



更新 2

这是我将其设置为函数的方法:

Public Function extractURL(url As String, tag As String) As String
    extractURL = ""

    Dim IE As InternetExplorer
    Dim html As HTMLDocument

    Set IE = New InternetExplorerMedium
    IE.Visible = False
    IE.Navigate2 url

    ' Wait while IE loading
    Do While IE.Busy
        Application.Wait DateAdd("s", 1, Now)
    Loop

    Set html = IE.Document
    Set spanElement = html.getElementsByTagName(tag)

    For Each spn In spanElement
        If Left(spn.innertext, 1) = "$" Then
            extractURL = spn.innertext
            Exit For
        End If
    Next spn

    'Cleanup
    IE.Quit
    Set IE = Nothing
End Function

表看起来像这样:



单元格中的公式 A2看起来像这样: =extractURL(C2,B2)
注意:此页面需要一段时间才能加载(在我的慢速连接上)，有时脚本没有返回任何内容。如果我单步执行代码并强制它等待页面完成加载，那么我总是得到正确的结果。在 IE 发出加载完成的信号后，可能有一些页面脚本仍在加载数据。解决这个问题的唯一方法是增加等待时间。