根据excel单元格中的链接获取网络数据

Question

我想创建一个 Excel 表格，其中一列中有一个网站链接（例如https://grieferwert.com/?product=beacon-3），而在下一列中，Excel 应该会自动导入价格历史图表数据。对于来自具有相同结构的网站（例如https://grieferwert.com/?product=sand-dk）的不同行中的多个链接，这应该是可能的。如何使网络查询基于相邻单元格中的链接？

The table on this screenshot is what the "add data from web" does, on the left the link to the website.

我尝试手动执行此操作，因此对于每个链接，我手动插入了一个数据查询。这是可能的，但我想要包含的所有条目都需要很长时间。

这里没有手动编写代码，最新的 Excel 发行版的所有板子功能。不过，我可以从高级电源查询编辑器中提取以下内容：

let
Quelle = Web.Page(Web.Contents("https://grieferwert.com/?product=sand-dk")),
Data0 = Quelle{0}[Data],
#"Geänderter Typ" = Table.TransformColumnTypes(Data0,{{"Type", type text}, {"Price", type text}, {"When", type date}})
in
#"Geänderter Typ"

我希望数据表根据链接单元格的变化而变化；所以当我更改链接时（交换上面提到的两者），刷新数据后数据应该会发生相应的变化。最后，我想用别处表格中的数字做一些简单的计算。

Answer 1

把你的网址放在A列，从A1开始，然后每隔7行，然后运行下面的代码（你可以attach this code to a form control button通过按钮来运行）

使用 Alt+F11 打开 VBE。右键单击project explorer pane 并添加standard module 然后将下面的代码添加到标准模块中。

当 VBE 打开时：您需要转到 VBE > 工具 > 参考 > add a reference 到 Microsoft HTML Object Library

代码使用XHR检索网页HTML，然后使用其类属性匹配表格

Set hTable = html.querySelector(".product_pane")

querySelector 将css class selector 应用于HTMLDocument（保存在变量html 中）以检索匹配项。

然后我使用剪贴板将表格复制粘贴到工作表中。

---

VBA：

Option Explicit
Public Sub GetTables()
    Dim urls(), i As Long, html As HTMLDocument, hTable As Object
    Dim ws As Worksheet, clipboard As Object, lastRow As Long

    Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")  
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    ws.Columns("C:E").ClearContents
    lastRow = ws.Cells(ws.rows.Count, "A").End(xlUp).Row
    urls = Application.Transpose(ws.Range("A1:A" & lastRow).Value)
    Set html = New HTMLDocument

    With CreateObject("MSXML2.XMLHTTP")
        For i = LBound(urls) To UBound(urls) Step 6
            .Open "GET", urls(i), False
            .send
            html.body.innerHTML = .responseText
            Set hTable = html.querySelector(".product_pane")
            clipboard.SetText hTable.outerHTML '5 rows per table
            clipboard.PutInClipboard
            ws.Range("C" & i).PasteSpecial
        Next
    End With
End Sub

---

工作表 1 中的示例布局：

_{*运行代码后返回C:E列的值}

Answer 2

以下内容用于解决您的这部分问题：

Excel 应该会自动导入价格历史图表数据

您正在戳的页面提供了一种非常方便的方式来下载您感兴趣的数据。您可以通过向相应的服务器发送XML HTTP request (XHR) 来完成。

通过在浏览器的开发人员工具中检查网络流量，您可以轻松看到这一点。在那里，您将看到加载页面时发送的一堆请求。其中大多数与请求样式表 (css) 或 png 和 gif 文件有关。其他人调用需要执行的脚本（js）。您需要的是XHR 请求，它以JSON 格式获取数据作为响应。

仔细查看请求，您会发现它由 URL、标头和正文组成。正文包含请求的参数。在这种情况下，您只需要一个product code。

鉴于上述情况，您可以在 VBA 中构造请求并将其发送到服务器以获取感兴趣的数据。更改产品代码参数将为您获取每个产品的相应数据。

为此，您需要将JSON parser 导入您的项目。按照说明操作即可。

那么你需要一些参考资料（VB 编辑器>工具>参考资料）：

1. Microsoft WinHTTP Services 5.1 版（用于创建和操作 HTTP 请求）
2. Microsoft 运行时脚本（JSON 解析器需要）

那么代码应该是这样的：

Option Explicit

Sub downloadPriceData()
Dim req As New WinHttpRequest
Dim URL As String, reqBody As String, productCode As String
Dim respTxt As String
Dim respJSON As Object
URL = "https://grieferwert.com/wp-admin/admin-ajax.php"
productCode = getProductCode("sand-dk") 'Changing the product name will get the corresponding data.

'productCode = "200" 'Hard coded version. Each product has its own code. You can see the code by inspectig the request's body as shown in the screenshots

reqBody = "action=wooPriceHistoryAjax&subaction=getGraph&product=" & productCode & "&period=1"
With req
    .Open "POST", URL, False
    .setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8" 'This is the only header that's absolutely essential to the request
    .send reqBody
    respTxt = .responseText
End With
Set respJSON = JsonConverter.ParseJson(respTxt)
Debug.Print respJSON("status")
Debug.Print respJSON("json")("rows")(1)("price")("value") 'This prints the first data point. The structure of the JSON can be seen in the screenshot.

End Sub


Public Function getProductCode(productName As String) As String 'This functions finds the product code, given the name of the product
Dim req As New WinHttpRequest
Dim doc As New HTMLDocument
Dim div As HTMLDivElement
Dim URL As String

URL = "https://grieferwert.com/?product=" & productName
With req
    .Open "GET", URL, False
    .send
    doc.body.innerHTML = .responseText
End With
Set div = doc.getElementById("ph_chart_container")
getProductCode = div.Attributes("data-product").Value
End Function

以上演示代码将只打印immediate window 中的一个数据点。将产品名称存储在工作表中并循环访问它们而不是循环访问链接将为您获取您感兴趣的所有产品的数据。

这应该让您开始着手获取其余数据。

编辑

编辑了最初的帖子，以包含一种根据产品名称自动获取产品代码的方法。