如何修改现有VBA XMLHTTP代码以爬取Investing.com经济指标数据

• 你原有代码调用的是Investing的通用历史数据接口，仅需修改请求参数和返回值解析逻辑即可适配经济指标数据爬取，不需要更换整体实现逻辑。
• 核心修改点是替换POST请求的send参数，经济类指标的curr_id与金融产品不同，本次你要爬取的核心耐用品订单对应curr_id为59，请求头不需要修改。
• 经济指标返回的历史表格仅包含4-5列，需要调整单元格赋值逻辑避免下标越界报错。

修改后的完整可运行代码如下：

Option Explicit
Sub 导出核心耐用品订单数据()

'Html对象定义---------------------------------------'
 Dim htmlDoc As MSHTML.HTMLDocument
 Dim htmlBody As MSHTML.htmlBody
 Dim ieTable As MSHTML.HTMLTable
 Dim Element As MSHTML.HTMLElementCollection


'工作簿、工作表、变量定义 ----------------'
 Dim wb As Workbook
 Dim Table As Worksheet
 Dim i As Long

 Set wb = ThisWorkbook
 Set Table = wb.Worksheets("Sheet1") '可修改为你自己的工作表名

 Dim xmlHttpRequest As New MSXML2.XMLHTTP60


 i = 2

'接口请求--------------------------------------------------------------------------'
 With xmlHttpRequest
 .Open "POST", "https://www.investing.com/instruments/HistoricalDataAjax", False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.setRequestHeader "X-Requested-With", "XMLHttpRequest"
'修改此处send参数为核心耐用品订单对应参数，可自行调整起止日期
.send "curr_id=59&smlID=20582&header=核心耐用品订单历史数据&st_date=01%2F01%2F2017&end_date=03%2F01%2F2024&interval_sec=Monthly&sort_col=date&sort_ord=DESC&action=historical_data"


 If .Status = 200 Then

        Set htmlDoc = CreateHTMLDoc
        Set htmlBody = htmlDoc.body

        htmlBody.innerHTML = xmlHttpRequest.responseText

        Set ieTable = htmlDoc.getElementById("curr_table")

        For Each Element In ieTable.getElementsByTagName("tr")
            '经济指标仅需提取日期、公布值、预测值、前值四列，按需调整列数
            If Element.Children.Length >=4 Then
                Table.Cells(i, 1) = Element.Children(0).innerText '日期
                Table.Cells(i, 2) = Element.Children(1).innerText '公布值
                Table.Cells(i, 3) = Element.Children(2).innerText '预测值
                Table.Cells(i, 4) = Element.Children(3).innerText '前值
                i = i + 1
            End If
        DoEvents: Next Element
 End If
End With


Set xmlHttpRequest = Nothing
Set htmlDoc = Nothing
Set htmlBody = Nothing
Set ieTable = Nothing
Set Element = Nothing

End Sub

Public Function CreateHTMLDoc() As MSHTML.HTMLDocument
    Set CreateHTMLDoc = CreateObject("htmlfile")
End Function

注意事项 #

• 使用前请确保VBA引用中已经勾选Microsoft HTML Object Library和Microsoft XML, v6.0，否则会报变量类型错误。
• 若请求返回空值，可打开对应网页刷新后抓包更新请求参数中的smlID即可正常使用。

内容的提问来源于stack exchange，提问作者Karol Sokol