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

我正在尝试使用一个类似于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")

我得到了价值！当你试图从这个网站获取数据时，应该是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的子函数转换为函数，但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

---

上一个示例中的URL仅返回

HTML

而不是

XML

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

标记

确保您：

添加了对“Microsoft Internet控件”的引用

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

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

---

---

测试

---

更新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发出加载完成的信号后，可能有一些页面脚本仍在加载数据。解决这个问题的唯一方法是增加等待时间。

对不起，我不知道如何实现您的代码。输入应该是什么？因为我有很多URL，我将从中删除这些数据，所以我尝试将您的sub转换为一个函数。你可以在原始帖子中找到我的代码。我用一个函数示例更新了帖子。不确定函数是否正确，因为当单元格重新计算所有HTML请求时，您的页面可能会有很长的延迟时间。如果我计划从数千个URL中提取相同的数据，您会建议我怎么做？目前，我已经找到了一个可以实现这一点的程序，但如果我能在excel中完成所有的工作，我肯定会这样做。就我个人而言，我会在一个按钮点击事件上运行这个程序，用URL循环你的单元格，然后从循环中调用函数。通过这种方式，您可以确保数据上次更新的时间，而不必每次更改工作表时等待几分钟，以便重新计算每个函数。只是想一想，你当然也可以用另一种方式。希望这有帮助。

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