excel - 在雅虎财经中检索数据报价的 URL 问题
问题描述
当我尝试从特定股票中检索报价时,来自 Yahoo 的 URL 不起作用。有几个关于它的讨论,但是,似乎没有显示关于 VBA 宏
Sub Get_Data()
Dim URL As String
Dim Ticker As String
Dim http As New WinHttpRequest
Dim sCotes As String
Dim Lignes
Dim Valeurs
Dim i As Long
Dim j As Long
Dim sLigne As String
Dim sValeur As String
Ticker = Range("Ticker")
URL = "https://query1.finance.yahoo.com/v7/finance/download/TECK?period1=1540456339&period2=1571992339&interval=1d&events=history&crumb=kjOZLFv6ch2"
http.Send
sCotes = http.ResponseText
MsgBox sCotes
Lignes = Split(sCotes, Chr(10))
For i = 1 To UBound(Lignes) 'until the end of the Lignes variable
sLigne = Lignes(i)
Valeurs = Split(sLigne, ",")
For j = 0 To UBound(Valeurs) - 1
Select Case j
Case 0
sValeur = DateSerial(CLng(Left(Valeurs(0), 4)), CLng(Mid(Valeurs(0), 6, 2)), CLng(Right(Valeurs(0), 2)))
Case 5
sValeur = CLng(Valeurs(5))
Case Else
sValeur = CDbl(Replace(Valeurs(j), ".", ","))
End Select
Range("A1").Offset(i, j) = sValeur
Application.StatusBar = Format(Cells(i, 1), "Short Date")
Next
Next
Application.StatusBar = False
End Sub
步骤 Http.send 处的执行错误:“在调用 Open 方法之前无法调用此方法”
解决方案
在尝试发送之前,您需要使用“open”方法,并且 GET 非常好。然而,有几件事......
有一个更简单的方法。值得添加的标头是 User-Agent 和一个用于减轻服务缓存结果的标头。下面向您展示如何在指定时间段内从服务器获取 json 响应并写入 Excel。注意:您需要将代码连接到 url。您可能还应该测试来自服务器的响应代码以确保成功。
我使用 jsonconverter.bas 作为 json 解析器来处理响应。从这里下载原始代码并添加到名为 JsonConverter 的标准模块中。然后您需要转到 VBE > 工具 > 参考 > 添加对 Microsoft Scripting Runtime 的引用。从复制的代码中删除顶部的属性行。
startDate
和的值endDate
需要作为 unix 时间戳传递。@TimWilliams 写了一个不错的函数,toUnix
用于将 Date 转换为我使用的Unix。我添加了自己的函数来管理相反方向的转换。
此方法避免使用任何基于会话的标识符,从而避免您遇到无效 cookie 屑的问题。
VBA:
Option Explicit
Public Sub GetYahooHistoricData()
Dim ticker As String, ws As Worksheet, url As String, s As String
Dim startDate As Long, endDate As Long
Set ws = ThisWorkbook.Worksheets("Sheet1")
ticker = ws.Range("ticker") 'Range A1. Above write out range
endDate = toUnix("2019-10-27")
startDate = toUnix("2018-10-25")
url = "https://query1.finance.yahoo.com/v8/finance/chart/" & ticker & "?region=US&lang=en-US&includePrePost=false&interval=1d&period1=" & startDate & "&period2=" & endDate & "&corsDomain=finance.yahoo.com&.tsrc=finance"
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", url, False
.setRequestHeader "User-Agent", "Mozilla/5.0"
.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
.send
s = .responseText
End With
Dim json As Object
Set json = JsonConverter.ParseJson(s)("chart")("result")
Dim dates As Object, results(), rows As Object, adjClose As Object, r As Long, headers()
headers = Array("date", "close", "volume", "open", "high", "low", "adjclose")
Set dates = json(1)("timestamp")
ReDim results(1 To dates.Count, 1 To UBound(headers) + 1)
Set rows = json(1)("indicators")("quote")(1)
Set adjClose = json(1)("indicators")("adjclose")(1)("adjclose")
For r = 1 To dates.Count
results(r, 1) = GetDate(dates(r))
results(r, 2) = rows("close")(r)
results(r, 3) = rows("volume")(r)
results(r, 4) = rows("open")(r)
results(r, 5) = rows("high")(r)
results(r, 6) = rows("low")(r)
results(r, 7) = adjClose(r)
Next
With ws
.Cells(3, 1).Resize(1, UBound(headers) + 1) = headers
.Cells(4, 1).Resize(UBound(results, 1), UBound(results, 2)) = results
End With
End Sub
Public Function GetDate(ByVal t As Variant) As String
GetDate = Format$(t / 86400 + DateValue("1970-01-01"), "yyyy-mm-dd")
End Function
Public Function toUnix(ByVal dt As Variant) As Long
toUnix = DateDiff("s", "1/1/1970", dt)
End Function
前 10 行示例:
推荐阅读
- javascript - 有什么方法可以在 node.js 上运行外部进程并等待他的“返回”?
- android - 将 Android 源代码 (TextToSpeech) 的子集硬编码到应用程序中
- android - 我们真的需要为 Android 应用托管assetlinks.json 文件吗?
- python - 我的神经网络算法不起作用 mnist 数字
- algorithm - 有趣的搜索问题:查找不在列表中的值(每日编码问题,2020 年 5 月 26 日)
- php - 如何将空值传递给php cli
- c# - 防止空值显示在 API JSON 响应中
- c - puts() 只打印文本文件的最后一个元素
- python - 使用数据框中的 for 循环创建多个图
- html - 如何修复我的输入和按钮之间的间距?