VBA提取雅虎财经数据遇Run-time error '9'，求代码修复方案

我的VBA代码从雅虎财经提取股票数据时触发Run-time error '9'（下标越界），错误出现在ReDim resultArray(0 To UBound(csv_rows), 0 To nColumns) As Variant这一行。想知道这个错误是不是雅虎网站结构变更导致的？该怎么修改代码才能继续提取数据？

Sub getYahooFinanceData(tickerSymbol As String, startDate As String, endDate As String, frequency As String, _
cookie As String, crumb As String, ByVal ticker As Long)
    Dim resultFromYahoo As String
    Dim objRequest
    Dim csv_rows() As String
    Dim resultArray As Variant
    Dim nColumns As Integer
    Dim iRows As Integer
    Dim CSV_Fields As Variant
    Dim iCols As Integer
    Dim tickerURL As String

    'Construct URL
    '***************************************************
    tickerURL = "https://query1.finance.yahoo.com/v7/finance/download/" & tickerSymbol & _
        "?period1=" & startDate & _
        "&period2=" & endDate & _
        "&interval=" & frequency & "&events=history" & "&crumb=" & crumb
    'Sheets("Parameters").Range("K" & ticker - 1) = tickerURL
    '***************************************************
               
    'Get data from Yahoo
    '***************************************************
    Set objRequest = CreateObject("WinHttp.WinHttpRequest.5.1")
    With objRequest
        .Open "GET", tickerURL, False
        '.setRequestHeader "Cookie", cookie
        .send
        .waitForResponse
        resultFromYahoo = .ResponseText
    End With
    '***************************************************
        
    'Parse returned string into an array
    '***************************************************
    nColumns = 6 'number of columns minus 1  (date, open, high, low, close, adj close, volume)
    csv_rows() = Split(resultFromYahoo, Chr(10))
    csv_rows = Filter(csv_rows, csv_rows(0), False)
    ReDim resultArray(0 To UBound(csv_rows), 0 To nColumns) As Variant
     
    For iRows = LBound(csv_rows) To UBound(csv_rows)
        CSV_Fields = Split(csv_rows(iRows), ",")
        If UBound(CSV_Fields) > nColumns Then
            nColumns = UBound(CSV_Fields)
            ReDim Preserve resultArray(0 To UBound(csv_rows), 0 To nColumns) As Variant
        End If
    
        For iCols = LBound(CSV_Fields) To UBound(CSV_Fields)
            If IsNumeric(CSV_Fields(iCols)) Then
                resultArray(iRows, iCols) = Val(CSV_Fields(iCols))
            ElseIf IsDate(CSV_Fields(iCols)) Then
                resultArray(iRows, iCols) = CDate(CSV_Fields(iCols))
            Else
                resultArray(iRows, iCols) = CStr(CSV_Fields(iCols))
            End If
        Next
    Next
End Sub

1. Cookie未正确传递：原代码注释掉了setRequestHeader "Cookie", cookie，而雅虎财经的下载接口要求Cookie和Crumb配对验证，缺少Cookie会导致请求返回错误页面（比如403或登录提示），而非预期的CSV数据。此时Split(resultFromYahoo, Chr(10))得到的数组内容无效，后续Filter操作后csv_rows可能变成空数组，调用UBound(csv_rows)就会触发下标越界错误。
2. 硬编码列数风险：原代码固定nColumns=6，若雅虎调整了返回数据的列数，也可能导致数组维度不匹配，但当前主要问题还是请求失败导致的空数组。

1. 恢复Cookie请求头 #

取消注释.setRequestHeader "Cookie", cookie，确保请求携带验证信息，获取有效的CSV数据。

2. 增加请求有效性检查 #

在处理返回数据前，先判断请求状态和返回内容是否为有效CSV，避免空数组操作：

• 检查objRequest.Status是否为200（成功状态码）
• 检查resultFromYahoo是否包含CSV表头特征（比如"Date,Open,High"）

3. 动态处理空数组情况 #

在调用UBound(csv_rows)前，先判断数组是否为空，避免下标越界。

修改后的完整代码 #

Sub getYahooFinanceData(tickerSymbol As String, startDate As String, endDate As String, frequency As String, _
cookie As String, crumb As String, ByVal ticker As Long)
    Dim resultFromYahoo As String
    Dim objRequest
    Dim csv_rows() As String
    Dim resultArray As Variant
    Dim nColumns As Integer
    Dim iRows As Integer
    Dim CSV_Fields As Variant
    Dim iCols As Integer
    Dim tickerURL As String

    'Construct URL
    tickerURL = "https://query1.finance.yahoo.com/v7/finance/download/" & tickerSymbol & _
        "?period1=" & startDate & _
        "&period2=" & endDate & _
        "&interval=" & frequency & "&events=history" & "&crumb=" & crumb
               
    'Get data from Yahoo
    Set objRequest = CreateObject("WinHttp.WinHttpRequest.5.1")
    With objRequest
        .Open "GET", tickerURL, False
        .setRequestHeader "Cookie", cookie '恢复Cookie传递
        .send
        .waitForResponse
        
        '检查请求是否成功
        If .Status <> 200 Then
            MsgBox "请求失败，状态码：" & .Status & vbCrLf & .ResponseText
            Exit Sub
        End If
        
        resultFromYahoo = .ResponseText
    End With
    
    '检查返回是否为有效CSV
    If InStr(resultFromYahoo, "Date,Open,High") = 0 Then
        MsgBox "返回内容无效，可能是Cookie/Crumb过期或接口变更：" & vbCrLf & resultFromYahoo
        Exit Sub
    End If
        
    'Parse returned string into an array
    csv_rows() = Split(resultFromYahoo, Chr(10))
    '过滤空行
    csv_rows = Filter(csv_rows, "", False)
    Dim headerIndex As Integer
    headerIndex = -1
    '找到表头行索引
    For iRows = LBound(csv_rows) To UBound(csv_rows)
        If InStr(csv_rows(iRows), "Date,Open,High") > 0 Then
            headerIndex = iRows
            Exit For
        End If
    Next
    '移除表头行
    If headerIndex >= 0 Then
        Dim tempRows() As String
        ReDim tempRows(0 To UBound(csv_rows) - 1)
        Dim tempIdx As Integer: tempIdx = 0
        For iRows = LBound(csv_rows) To UBound(csv_rows)
            If iRows <> headerIndex Then
                tempRows(tempIdx) = csv_rows(iRows)
                tempIdx = tempIdx + 1
            End If
        Next
        csv_rows = tempRows
    End If
    
    '检查处理后的数组是否为空
    If UBound(csv_rows) < 0 Then
        MsgBox "无有效数据返回"
        Exit Sub
    End If
    
    '动态获取列数
    CSV_Fields = Split(csv_rows(0), ",")
    nColumns = UBound(CSV_Fields)
    ReDim resultArray(0 To UBound(csv_rows), 0 To nColumns) As Variant
     
    For iRows = LBound(csv_rows) To UBound(csv_rows)
        CSV_Fields = Split(csv_rows(iRows), ",")
        '确保列数匹配
        If UBound(CSV_Fields) > nColumns Then
            nColumns = UBound(CSV_Fields)
            ReDim Preserve resultArray(0 To UBound(csv_rows), 0 To nColumns) As Variant
        End If
    
        For iCols = LBound(CSV_Fields) To UBound(CSV_Fields)
            If IsNumeric(CSV_Fields(iCols)) Then
                resultArray(iRows, iCols) = Val(CSV_Fields(iCols))
            ElseIf IsDate(CSV_Fields(iCols)) Then
                resultArray(iRows, iCols) = CDate(CSV_Fields(iCols))
            Else
                resultArray(iRows, iCols) = CStr(CSV_Fields(iCols))
            End If
        Next
    Next
    
    '可添加将resultArray写入工作表的代码，示例：
    'Sheets("Data").Range("A1").Resize(UBound(resultArray)+1, UBound(resultArray,2)+1) = resultArray
End Sub

额外注意事项 #

• Cookie和Crumb需要从雅虎财经页面动态获取，且两者是配对的，Crumb过期后需要重新获取。
• 若后续雅虎再次变更接口，可能需要重新验证URL结构或请求参数。

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