2
votes

Problème d'URL lors de la récupération des devis de données dans Yahoo Finance

L'URL de Yahoo ne fonctionne pas lorsque j'essaie de récupérer des cotations d'une action particulière. Il y a plusieurs discussions à ce sujet, Cependant, il semble que rien ne soit montré concernant la macro 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

Erreur d'exécution à l'étape Http.send: "Cette méthode ne peut pas être appelée tant que la méthode Open n'a pas été appelée "

excel vba web-scraping get yahoo-finance

0 commentaires

3 Réponses :

0
votes

Essayez de remplacer ce code

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

par ce code:

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

L'erreur est assez claire: vous devez appeler le ouvrez la méthode avant la méthode Send . Ce serait également une demande POST. Vous devrez peut-être également mettre ces deux lignes après la méthode open :

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

4 commentaires

Pouvez-vous vraiment faire fonctionner le code avec "GET"? Voici la réponse que je reçois - "finance": {"error": {"code": "Unauthorized", "description": "Cookie invalide"

Cela fonctionne plutôt bien avec POST pour moi. Et il publie des données - period1 = 1540456339 , events = history , crumb = kjOZLFv6ch2 et etc.

@Vityata Vous avez peut-être raison, après avoir consulté ce fil de discussion: stackoverflow.com/questions/44030983/… . J'ai modifié ma réponse.

C'est intéressant, car c'est la même erreur que @Vityata a déclaré avoir reçue lors de l'utilisation de la requête GET au lieu de la requête POST. Alors maintenant, il semble qu'il renverra la même erreur quelle que soit la demande utilisée. Dans ce cas, votre miette de cookie de "kjOZLFv6ch2" doit être invalide, alors déterminez la bonne miette de cookie qui vous identifie en tant que Yahoo! utilisateur.

0
votes

La question est dupliquée à environ 99% comme celle d'ici - Comment puis-je envoyer une requête HTTP POST à un serveur depuis Excel en utilisant VBA? . Quoi qu'il en soit, l'erreur est évidemment, car la méthode .Send () envoie simplement un objet Dim http As New WinHttpRequest complètement vide.

Pour faire fonctionner le code, copiez l'exemple de la question dupliquée et imprimez le 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

0 commentaires

1
votes

Vous devrez utiliser la méthode "open" avant d'essayer d'envoyer et GET est parfaitement bien. Cependant, quelques petites choses ...

Il existe un moyen plus simple. Les en-têtes à ajouter sont User-Agent et un pour atténuer les résultats de la mise en cache. Ce qui suit vous montre comment obtenir une réponse json du serveur pendant une période spécifiée et écrire dans Excel. Remarque: vous devez concaténer le ticker dans l'URL. Vous devriez probablement aussi tester le code de réponse du serveur pour vous en assurer.

J'utilise jsonconverter.bas comme analyseur json pour gérer la réponse. Téléchargez le code brut sur ici et ajoutez-le au module standard appelé JsonConverter. Vous devez ensuite aller VBE> Outils> Références> Ajouter une référence à Microsoft Scripting Runtime. Supprimez la ligne d'attribut supérieure du code copié.

Les valeurs pour startDate et endDate doivent être passées sous forme d'horodatages unix. @TimWilliams a écrit une fonction sympa, toUnix , pour convertir Date en Unix ici que j'utilise. J'ai ajouté ma propre fonction pour gérer la conversion dans la direction opposée.

Cette méthode évite d'utiliser des identifiants basés sur la session et évite ainsi votre problème avec les miettes de cookies invalides.

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

Exemple 10 premières lignes:

1 commentaires

Merci beaucoup pour votre aide les gars! vraiment apprécié ! À votre santé