雅虎财务饼干屑不再工作

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。

https://finance.yahoo.com/quote/AAPL/history?period1=1503558000&period2=1535094000&interval=1wk&filter=history&frequency=1wk

我用邮递员寄 GET 对API的请求。响应头不包含 "Set-Cookie" ,也没有提到 ""CrumbStore"" “设置Cookie”

有人遇到过这种情况并有解决办法吗?