我有一个VBA宏，去年，他们在2017年第2季度更改了API之后，在互联网上找到了它。看来当我运行它时，他们可能又更改了它，我得到的是：
Error: ZNGA
Details: {
"finance": {
"error": {
"code": "Unauthorized",
"description": "Invalid cookie"
}
}
}
每一个股票。
我正在查看Sub，其中建立了面包屑和曲奇，如下所示：
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
它应该做的是将该链接上的表导入Excel，然后将其导入Access。
我正在使用Postman向API发送GET请求。响应标头不包含"Set-Cookie"，也不包含""CrumbStore""。 VBA确实会返回"Set-Cookie"的值以及我不希望看到的其他一些信息，所以对此不太了解。
有人遇到过这种情况并有解决方案吗？
答案 0 :(得分：0)
好的，实际上很简单。
此行：
.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
很明显，它过去只是通过查找任何东西来返回有效的crumb，而无论股票行情是否良好。现在，这样做不会返回CrumbStore，因此找不到任何内容。