雅虎财经 Cookie Crumb 不再有效
Yahoo Finance Cookie Crumb no longer working
我有一个 VBA 宏，去年他们在 2017 年第二季度左右更改了 API 后，我在互联网上的某个地方找到了它。看起来他们可能已经像我 运行 我得到的是：
Error: ZNGA
Details: {
"finance": {
"error": {
"code": "Unauthorized",
"description": "Invalid cookie"
}
}
}
对于每个代码。
我正在查看 Sub 建立面包屑和 cookie 的位置如下：
Sub BSRawData()
Dim sURL As String, sResult, strSQL As String
Dim oResult As Variant, oData As Variant, r As Long, c As Long, period1 As Double, period2 As Double
Dim db As Database
Dim rst As Recordset
Dim lastRow, recs, i, i2 As Integer
Dim baseDate As Date
Dim startDate As Date
Dim finalDate As Date
Dim crumb As String, cookie As String, validCookieCrumb As Boolean
' Load the ticker symbol into a recordset for iteration
Set db = CurrentDb
Set rst = db.OpenRecordset("SELECT DISTINCT Ticker FROM clients WHERE Ticker IS NOT NULL ORDER BY Ticker DESC;")
'Debug.Print (rst.RecordCount)
recs = rst.RecordCount
rst.MoveFirst
For i = 1 To recs
For i2 = 1 To 2
ExcelObject
Call getCookieCrumb(crumb, cookie, validCookieCrumb)
' Date ranges, do not need to touch the first one
baseDate = #1/1/1970#
startDate = #5/2/2017#
finalDate = #5/1/2018#
' Calculate the number of seconds
period1 = (startDate - baseDate) * 86400
period2 = Round((finalDate - baseDate + 0.33333333) * 86400)
' The first time through it fetches the 52-week data which does not contain dividends. The second time through it fetches dividends only.
If i2 = 1 Then
' Construct the URL string
sURL = "https://query1.finance.yahoo.com/v7/finance/download/" & rst!Ticker & "?period1=" & period1 & "&period2=" & period2 & "&interval=1wk&events=history&crumb=" & crumb
Else
' Construct the URL string
sURL = "https://query1.finance.yahoo.com/v7/finance/download/" & rst!Ticker & "?period1=" & period1 & "&period2=" & period2 & "&interval=1wk&events=div&crumb=" & crumb
End If
' Debug.Print "URL: " & sURL
' Pass the URL into the GetHTTPResult function
sResult = GetHTTPResult(sURL, cookie)
' Takes the result from the function and iterates through it, putting it into Excel
If sResult Like "*Error*" Then
Debug.Print ("Error: " & rst!Ticker)
Debug.Print ("Details: " & sResult)
xl.ActiveWorkbook.Close False
xl.Quit
GoTo NextRecord
End If
oResult = Split(sResult, vbLf)
' Debug.Print "Lines of result: " & UBound(oResult)
For r = 0 To UBound(oResult)
oData = Split(oResult(r), ",")
For c = 0 To UBound(oData)
If oData(UBound(oData)) <> "Null" Then
xl.ActiveSheet.Cells(r + 1, c + 1) = oData(c)
End If
Next c
Next r
Set oResult = Nothing
' Find and replace 'Date' with 'Week' to clear up reserved work complications
xl.Application.DisplayAlerts = False
xl.Cells.Replace What:="Date", Replacement:="Week", LookAt:=xlPart
xl.Application.DisplayAlerts = True
' Insert column and add ticker symbol. won't go into access without it since it is the primary key and indexed
xl.Columns("A").Insert Shift:=xlRight
xl.Range("A1").Value = "Ticker"
lastRow = xl.Cells(xl.Rows.Count, "B").End(xlUp).Row
xl.Range("A2:A" & lastRow).Value = rst!Ticker
' Save the file and close Excel
xl.Application.DisplayAlerts = False
xl.ActiveWorkbook.SaveAs fileName:="C:\Black-Scholes\temp.xlsx"
xl.Application.DisplayAlerts = True
xl.ActiveWorkbook.Close False
xl.Quit
' Go to next record if there were no dividends
If lastRow = 1 Then
GoTo NextRecord
End If
' Back to Access to delete records from the table if ticker is already in there
If i2 = 1 Then
DoCmd.SetWarnings False
strSQL = "DELETE * FROM blackscholes_raw_data WHERE Ticker = '" & rst!Ticker & "';"
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
End If
' Back to Access to import
DoCmd.TransferSpreadsheet acImport, TableName:="blackscholes_raw_data", fileName:="C:\Black-Scholes\temp.xlsx", HasFieldNames:=True
Next i2
NextRecord:
' On to the next record
rst.MoveNext
Next i
' Move dividends to the week they correspond to and delete row
DoCmd.SetWarnings False
strSQL = "UPDATE blackscholes_raw_data t1 " & _
"LEFT JOIN blackscholes_raw_data t2 " & _
"ON t1.Ticker = t2.Ticker " & _
"SET t1.Dividends = t2.Dividends " & _
"WHERE t1.Dividends IS NULL AND t2.Dividends IS NOT NULL AND t2.Week BETWEEN t1.Week AND t1.Week + 6;"
DoCmd.RunSQL strSQL
strSQL = "DELETE * FROM blackscholes_raw_data WHERE Open IS NULL;"
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
MsgBox "Done."
End Sub
Sub getCookieCrumb(crumb As String, cookie As String, validCookieCrumb As Boolean)
Dim i As Integer
Dim str As String
Dim crumbStartPos As Long
Dim crumbEndPos As Long
Dim objRequest
validCookieCrumb = False
For i = 0 To 5 'ask for a valid crumb 5 times
Set objRequest = CreateObject("WinHttp.WinHttpRequest.5.1")
With objRequest
.Open "GET", "https://finance.yahoo.com/lookup?s=bananas", False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"
.send
.waitForResponse (10)
cookie = Split(.getResponseHeader("Set-Cookie"), ";")(0)
crumbStartPos = InStr(1, .responseText, """CrumbStore"":{""crumb"":""", vbBinaryCompare) + Len("""CrumbStore"":{""crumb"":""")
crumbEndPos = InStr(crumbStartPos, .responseText, """", vbBinaryCompare)
crumb = Mid(.responseText, crumbStartPos, crumbEndPos - crumbStartPos)
End With
If Len(crumb) = 11 Then 'a valid crumb is 11 characters long
validCookieCrumb = True
Exit For
End If:
' If i = 5 Then ' no valid crumb
' validCookieCrumb = False
' End If
Next i
End Sub
Function GetHTTPResult(sURL As String, cookie As String) As String
Dim strUrl, sResult As String
Dim http As WinHttp.WinHttpRequest
Set http = New WinHttp.WinHttpRequest
' Uncomment the line directly below if you need to get a new crumb and cookie
' sURL = "https://finance.yahoo.com/lookup?s=%7B0%7D"
' strCookie = "B=bnnkr99cklnh9&b=3&s=69"
With http
.Open "GET", sURL, False
.setRequestHeader "Cookie", cookie
.send
.waitForResponse
' Debug.Print (http.responseText)
' Debug.Print "Status: " & http.Status & " - " & http.statusText
sResult = .responseText
Set http = Nothing
GetHTTPResult = sResult
End With
End Function
它应该做的是将此link上的table导入Excel，然后将其导入Access。
我正在使用 Postman 向 API 发送 GET 请求。响应 header 不包含 "Set-Cookie"，也没有提及 ""CrumbStore""。 VBA 为 "Set-Cookie" 做 return 值和其他一些我不希望它做的事情，所以不太明白。
有人遇到过这个问题并有解决方案吗？
好的，实际上修复非常简单。
这一行：
.Open "GET", "https://finance.yahoo.com/lookup?s=bananas", False
只需要更改为有效的代码。所以为了我的需要，我做了：
.Open "GET", "https://finance.yahoo.com/quote/AAPL/history?period1=1503558000&period2=1535094000&interval=1wk&filter=history&frequency=1wk", False
显然，它曾经 return 一个有效的 crumb 通过查找任何东西，无论代码是否正确。现在这样做没有 return CrumbStore，所以找不到任何东西。
我有一个 VBA 宏，去年他们在 2017 年第二季度左右更改了 API 后，我在互联网上的某个地方找到了它。看起来他们可能已经像我 运行 我得到的是：
Error: ZNGA
Details: {
"finance": {
"error": {
"code": "Unauthorized",
"description": "Invalid cookie"
}
}
}
对于每个代码。
我正在查看 Sub 建立面包屑和 cookie 的位置如下：
Sub BSRawData()
Dim sURL As String, sResult, strSQL As String
Dim oResult As Variant, oData As Variant, r As Long, c As Long, period1 As Double, period2 As Double
Dim db As Database
Dim rst As Recordset
Dim lastRow, recs, i, i2 As Integer
Dim baseDate As Date
Dim startDate As Date
Dim finalDate As Date
Dim crumb As String, cookie As String, validCookieCrumb As Boolean
' Load the ticker symbol into a recordset for iteration
Set db = CurrentDb
Set rst = db.OpenRecordset("SELECT DISTINCT Ticker FROM clients WHERE Ticker IS NOT NULL ORDER BY Ticker DESC;")
'Debug.Print (rst.RecordCount)
recs = rst.RecordCount
rst.MoveFirst
For i = 1 To recs
For i2 = 1 To 2
ExcelObject
Call getCookieCrumb(crumb, cookie, validCookieCrumb)
' Date ranges, do not need to touch the first one
baseDate = #1/1/1970#
startDate = #5/2/2017#
finalDate = #5/1/2018#
' Calculate the number of seconds
period1 = (startDate - baseDate) * 86400
period2 = Round((finalDate - baseDate + 0.33333333) * 86400)
' The first time through it fetches the 52-week data which does not contain dividends. The second time through it fetches dividends only.
If i2 = 1 Then
' Construct the URL string
sURL = "https://query1.finance.yahoo.com/v7/finance/download/" & rst!Ticker & "?period1=" & period1 & "&period2=" & period2 & "&interval=1wk&events=history&crumb=" & crumb
Else
' Construct the URL string
sURL = "https://query1.finance.yahoo.com/v7/finance/download/" & rst!Ticker & "?period1=" & period1 & "&period2=" & period2 & "&interval=1wk&events=div&crumb=" & crumb
End If
' Debug.Print "URL: " & sURL
' Pass the URL into the GetHTTPResult function
sResult = GetHTTPResult(sURL, cookie)
' Takes the result from the function and iterates through it, putting it into Excel
If sResult Like "*Error*" Then
Debug.Print ("Error: " & rst!Ticker)
Debug.Print ("Details: " & sResult)
xl.ActiveWorkbook.Close False
xl.Quit
GoTo NextRecord
End If
oResult = Split(sResult, vbLf)
' Debug.Print "Lines of result: " & UBound(oResult)
For r = 0 To UBound(oResult)
oData = Split(oResult(r), ",")
For c = 0 To UBound(oData)
If oData(UBound(oData)) <> "Null" Then
xl.ActiveSheet.Cells(r + 1, c + 1) = oData(c)
End If
Next c
Next r
Set oResult = Nothing
' Find and replace 'Date' with 'Week' to clear up reserved work complications
xl.Application.DisplayAlerts = False
xl.Cells.Replace What:="Date", Replacement:="Week", LookAt:=xlPart
xl.Application.DisplayAlerts = True
' Insert column and add ticker symbol. won't go into access without it since it is the primary key and indexed
xl.Columns("A").Insert Shift:=xlRight
xl.Range("A1").Value = "Ticker"
lastRow = xl.Cells(xl.Rows.Count, "B").End(xlUp).Row
xl.Range("A2:A" & lastRow).Value = rst!Ticker
' Save the file and close Excel
xl.Application.DisplayAlerts = False
xl.ActiveWorkbook.SaveAs fileName:="C:\Black-Scholes\temp.xlsx"
xl.Application.DisplayAlerts = True
xl.ActiveWorkbook.Close False
xl.Quit
' Go to next record if there were no dividends
If lastRow = 1 Then
GoTo NextRecord
End If
' Back to Access to delete records from the table if ticker is already in there
If i2 = 1 Then
DoCmd.SetWarnings False
strSQL = "DELETE * FROM blackscholes_raw_data WHERE Ticker = '" & rst!Ticker & "';"
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
End If
' Back to Access to import
DoCmd.TransferSpreadsheet acImport, TableName:="blackscholes_raw_data", fileName:="C:\Black-Scholes\temp.xlsx", HasFieldNames:=True
Next i2
NextRecord:
' On to the next record
rst.MoveNext
Next i
' Move dividends to the week they correspond to and delete row
DoCmd.SetWarnings False
strSQL = "UPDATE blackscholes_raw_data t1 " & _
"LEFT JOIN blackscholes_raw_data t2 " & _
"ON t1.Ticker = t2.Ticker " & _
"SET t1.Dividends = t2.Dividends " & _
"WHERE t1.Dividends IS NULL AND t2.Dividends IS NOT NULL AND t2.Week BETWEEN t1.Week AND t1.Week + 6;"
DoCmd.RunSQL strSQL
strSQL = "DELETE * FROM blackscholes_raw_data WHERE Open IS NULL;"
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
MsgBox "Done."
End Sub
Sub getCookieCrumb(crumb As String, cookie As String, validCookieCrumb As Boolean)
Dim i As Integer
Dim str As String
Dim crumbStartPos As Long
Dim crumbEndPos As Long
Dim objRequest
validCookieCrumb = False
For i = 0 To 5 'ask for a valid crumb 5 times
Set objRequest = CreateObject("WinHttp.WinHttpRequest.5.1")
With objRequest
.Open "GET", "https://finance.yahoo.com/lookup?s=bananas", False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"
.send
.waitForResponse (10)
cookie = Split(.getResponseHeader("Set-Cookie"), ";")(0)
crumbStartPos = InStr(1, .responseText, """CrumbStore"":{""crumb"":""", vbBinaryCompare) + Len("""CrumbStore"":{""crumb"":""")
crumbEndPos = InStr(crumbStartPos, .responseText, """", vbBinaryCompare)
crumb = Mid(.responseText, crumbStartPos, crumbEndPos - crumbStartPos)
End With
If Len(crumb) = 11 Then 'a valid crumb is 11 characters long
validCookieCrumb = True
Exit For
End If:
' If i = 5 Then ' no valid crumb
' validCookieCrumb = False
' End If
Next i
End Sub
Function GetHTTPResult(sURL As String, cookie As String) As String
Dim strUrl, sResult As String
Dim http As WinHttp.WinHttpRequest
Set http = New WinHttp.WinHttpRequest
' Uncomment the line directly below if you need to get a new crumb and cookie
' sURL = "https://finance.yahoo.com/lookup?s=%7B0%7D"
' strCookie = "B=bnnkr99cklnh9&b=3&s=69"
With http
.Open "GET", sURL, False
.setRequestHeader "Cookie", cookie
.send
.waitForResponse
' Debug.Print (http.responseText)
' Debug.Print "Status: " & http.Status & " - " & http.statusText
sResult = .responseText
Set http = Nothing
GetHTTPResult = sResult
End With
End Function
它应该做的是将此link上的table导入Excel，然后将其导入Access。
我正在使用 Postman 向 API 发送 GET 请求。响应 header 不包含 "Set-Cookie"，也没有提及 ""CrumbStore""。 VBA 为 "Set-Cookie" 做 return 值和其他一些我不希望它做的事情，所以不太明白。
有人遇到过这个问题并有解决方案吗？
好的，实际上修复非常简单。
这一行：
.Open "GET", "https://finance.yahoo.com/lookup?s=bananas", False
只需要更改为有效的代码。所以为了我的需要，我做了：
.Open "GET", "https://finance.yahoo.com/quote/AAPL/history?period1=1503558000&period2=1535094000&interval=1wk&filter=history&frequency=1wk", False
显然，它曾经 return 一个有效的 crumb 通过查找任何东西，无论代码是否正确。现在这样做没有 return CrumbStore，所以找不到任何东西。