在Excel VBA中使用XMLHTTP下载网站的表格不起作用

Question

我正在尝试从以下网站下载历史黄金价格表:www.lbma.org.uk prices-and-data precious-metal-prices #/表

Dim http As MSXML2.XMLHTTP60 
Set http = New MSXML2.XMLHTTP60
With http
.Open "GET", "https://www.lbma.org.uk/prices-and-data/precious-metal-prices#/table", True 
.setRequestHeader "User-Agent", "Mozilla/5.0"
.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
.send
Do  ' Wait till the page is loaded
DoEvents
Sleep (1)
Loop Until .ReadyState = 4
End With

http。responseText长115kB，包含页面中的所有文本等，但没有包含黄金价格数据的实际表。我对xmlhttp很陌生-知道我做错了什么吗?

Answer 1

这是一种只拉AM价格的方法，如果你愿意，这应该很容易扩展到拉PM价格。

我所做的是审查在这个网站上的XHR请求，并注意到它使用JSON将数据发送到每个部分的价格页面。这可能就是为什么您在页面上找不到表HTML的原因，它正在被创建。

为了编写这段代码，您需要加载VBA-JSON项目。这是用来解析JSON的，您可以在这里找到。按照页面上的说明添加

Option Explicit
Public Function GetHistoricalGoldPricesJSON() As String
On Error GoTo ErrHand:
Const url As String = "https://prices.lbma.org.uk/json/gold_am.json?r=166366104"

With CreateObject("MSXML2.XMLHTTP")
.Open "GET", url, False
.send
GetHistoricalGoldPricesJSON = .ResponseText
End With

Exit Function

ErrHand:
GetHistoricalGoldPricesJSON = ""
End Function
Public Function GetGoldPricesJSON(JsonString As String) As Object
On Error Resume Next
If JsonString = "" Then
Set GetGoldPricesJSON= Nothing
Exit Function
End If

Set GetGoldPricesJSON= JsonConverter.ParseJson(JsonString)
End Function
Public Sub GetGoldPrices()
Dim GoldPrices As Object: Set GoldPrices = GetGoldPricesJSON(GetHistoricalGoldPricesJSON())

'Nothing found or there was an error
If GoldPrices Is Nothing Then Exit Sub

Dim GoldPrice  As Variant
Dim GoldArray  As Variant
Dim Price      As Variant: ReDim GoldArray(1 To 50000, 1 To 4)
Dim i          As Long

For Each GoldPrice In GoldPrices
i = i + 1
GoldArray(i, 1) = GoldPrice("d")
GoldArray(i, 2) = GoldPrice("v")(1)
GoldArray(i, 3) = GoldPrice("v")(2)
GoldArray(i, 4) = GoldPrice("v")(3)
Next

With ThisWorkbook.Sheets(1)
.Cells.ClearContents
.Range("A1:D1") = Array("Date", "USD AM Price", "GBP AM Price", "EUR AM Price")
.Range(.Cells(2, 1), .Cells(i + 1, 4)) = GoldArray
End With

End Sub