Проблема с URL-адресом при извлечении котировок данных из финансов Yahoo

Question

URL-адрес от Yahoo не работает, когда я пытаюсь получить цитаты из определенной акции. Существует несколько дискуссий по этому поводу, однако, кажется, ничего не показано в отношении макроса 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»

Answer 1

Вопрос примерно на 99% повторяется, как показано здесь - Как я могу отправить HTTP-запрос POST на сервер из Excel, используя VBA? . В любом случае, очевидно, что ошибка в том, что метод .Send() просто отправляет полностью пустой объект Dim http As New WinHttpRequest.

Чтобы заставить код работать, скопируйте пример из дублированного вопроса и напечатайте http.ResponseText:

Sub TestMe()

    Dim http As Object
    Dim url As String
    Set http = CreateObject("MSXML2.ServerXMLHTTP.6.0")
    url = "https://query1.finance.yahoo.com/v7/finance/download/TECK?period1=1540456339&period2=1571992339&interval=1d&events=history&crumb=kjOZLFv6ch2"
    http.Open "POST", url, False
    http.Send
    MsgBox http.responsetext

End Sub

Answer 2

Вам нужно будет использовать метод "open", прежде чем пытаться отправить, и GET отлично подойдет. Тем не менее, несколько вещей ....

Есть более простой способ. Заголовки, которые стоит добавить, это User-Agent и один, чтобы уменьшить количество обслуживаемых кэшированных результатов. Ниже показано, как получить ответ json с сервера за указанный период времени и выполнить запись в Excel. Примечание: вам нужно объединить тикер в URL. Возможно, вам также следует проверить код ответа с сервера, чтобы убедиться в его успешности.

Я использую jsonconverter.bas в качестве парсера json для обработки ответа. Загрузите необработанный код с здесь и добавьте в стандартный модуль JsonConverter. Затем вам нужно перейти VBE> Инструменты> Ссылки> Добавить ссылку в Microsoft Scripting Runtime. Удалите верхнюю строку атрибута из скопированного кода.

Значения startDate и endDate необходимо передать как метки времени Unix. @TimWilliams написал замечательную функцию toUnix для преобразования даты в 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 лучших строк:

Answer 3

Попробуйте заменить этот код

URL = "https://query1.finance.yahoo.com/v7/finance/download/TECK?period1=1540456339&period2=1571992339&interval=1d&events=history&crumb=kjOZLFv6ch2"
http.Send

на этот код:

set http = Server.Createobject("MSXML2.ServerXMLHTTP.6.0")
URL = "https://query1.finance.yahoo.com/v7/finance/download/TECK?period1=1540456339&period2=1571992339&interval=1d&events=history&crumb=kjOZLFv6ch2"
http.open "POST", URL, False
http.Send

Ошибка довольно очевидна: перед методом Send необходимо вызвать метод open,Также это будет запрос POST. Вам также может понадобиться поставить эти две строки после метода open:

http.setRequestHeader "Content-Type", "application/x-www-form-urlencoded" 
http.setRequestHeader "Content-Length", 0