Rapatriement données cachées derrière un lien hypertext

je n'ai pas trouvé de incomeSheetHistory (il n'y a que balanceSheetHistory)

Oui pardon

incomeStatementHistory

Il y a forcément les 3, même si les valeurs sont vides parfois. Peut être envoyer les 3 requêtes (URL selon les donnes voulues financials, balance-sheet, cash-flow)?🤔

autre subtilité, le endDate.raw est une date epoch (timestamp) à convertir

C'est tellement complexe comme structure de json que pour le moment je te donne des données brutes dans une feuille. Et tout ce qu'il y a sous QuoteSummaryStore

Sélectionne l'url qui te convient et lance la macro.

J'ai dû sortir l'artillerie lourde :

• j'ai encore complété le code javascript pour rechercher les sous-objets mais aussi maintenant les attributs sans connaître a priori leur libellé

    Set ScriptEngine = CreateObject("MSScriptControl.ScriptControl")
    With ScriptEngine
        .Language = "JScript"
        .AddCode "Object.prototype.element=function( i ) { return this[i] } ; "
        .AddCode "function attributs(jsonObj){var output = ''; for (var property in jsonObj) {if ((typeof jsonObj[property] !== 'object') && (typeof jsonObj[property] !== 'function')) {output += property + '::' + jsonObj[property] + '||';};};return output.substr(0,output.length-2);} "
        .AddCode "function objets(jsonObj){var output = ''; for (var property in jsonObj) {if (typeof jsonObj[property] === 'object' && jsonObj[property] !== null) {output += property + '||';};};return output.substr(0,output.length-2);} "
    End With

• et j'ai réalisé une fonction itérative

Sub decoder(o As Object)
Dim i%, t As Variant
    t = Split(ScriptEngine.Run("attributs", o), "||")
    For i = 0 To UBound(t)
        If Split(t(i), "::")(0) = "raw" Then
            Cells(ligne, niveau) = Split(t(i), "::")(1)
            ligne = ligne + 1
        End If
    Next
    t = Split(ScriptEngine.Run("objets", o), "||")
    For i = 0 To UBound(t)
        If IsNumeric(t(i)) Then
            Cells(ligne, niveau) = ".element(" & t(i) & ")"
        ElseIf IsNumeric(Left(t(i), 1)) Then
            Cells(ligne, niveau) = ".element(""" & t(i) & """)"
        Else
            Cells(ligne, niveau) = "." & t(i)
        End If
        niveau = niveau + 1
            decoder o.element(t(i))
        niveau = niveau - 1
    Next
End Sub

Bonjour,

autre présentation si tu veux un tableau avec appel à cette fonction

Function tableau(url As String)

la première colonne comprend les différents termes que tu peux splitter pour rechercher les indices ou les éléments que tu souhaites, exemple

QuoteSummaryStore.cashflowStatementHistory.cashflowStatements.0.endDate

le code avec importation dans la feuille

Option Explicit
Option Base 1
Dim n As Long, resultat()
Dim ScriptEngine As Object

Sub extraire()
    Dim url As String, data()
    If Selection.Cells.Count > 1 Or Selection.Cells(1, 1).Value = "" Then MsgBox "Sélectionner une seule URL": Exit Sub
    url = Selection
    data = Application.Transpose(tableau(url))

    Sheets("valeurs").Select
    Cells.Clear
    Range("A1").Resize(UBound(data, 1), UBound(data, 2)) = (data)
End Sub

Function tableau(url As String)
Dim json As String

    Set ScriptEngine = CreateObject("MSScriptControl.ScriptControl")
    With ScriptEngine
        .Language = "JScript"
        .AddCode "Object.prototype.element=function( i ) { return this[i] } ; "
        .AddCode "function attributs(jsonObj){var output = ''; for (var property in jsonObj) {if ((typeof jsonObj[property] !== 'object') && (typeof jsonObj[property] !== 'function')) {output += property + '::' + jsonObj[property] + '||';};};return output.substr(0,output.length-2);} "
        .AddCode "function objets(jsonObj){var output = ''; for (var property in jsonObj) {if (typeof jsonObj[property] === 'object' && jsonObj[property] !== null) {output += property + '||';};};return output.substr(0,output.length-2);} "
    End With

    Dim data As Object
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", url, False
        .send
        json = Split(Split(.responsetext, "root.App.main = ")(1), "}}}};")(0) + "}}}}"
        Set data = ScriptEngine.Eval("(" + CStr(json) + ")")
    End With

    ReDim resultat(2, 1)
    n = 1
    decoder data.element("context").dispatcher.stores.QuoteSummaryStore, "QuoteSummaryStore"

    tableau = resultat

End Function

Sub decoder(o As Object, id As String)
Dim i%, t As Variant
    t = Split(ScriptEngine.Run("attributs", o), "||")
    For i = 0 To UBound(t)
        If Split(t(i), "::")(0) = "raw" Then
            resultat(2, n) = Split(t(i), "::")(1)
            n = n + 1
            ReDim Preserve resultat(2, n)
        End If
    Next
    t = Split(ScriptEngine.Run("objets", o), "||")
    For i = 0 To UBound(t)
        resultat(1, n) = id + "." & t(i)
        decoder o.element(t(i)), id + "." + t(i)
    Next
End Sub

Merci pour tes derniers codes.

J'ai intégré le dernier, qui fonctionne correctement. Seul un problème subsiste:

La taille de QuoteSummaryStore varie, donc je ne peux pas aller chercher des valeurs selon le numéro de ligne !! snif

As-tu une idée? Ou il faut absolument que je fige les libellés (const) et que je recherche par ces libellés les valeurs associées?

Dans la version v5, le résultat est un array, donc tu peux facilement le balayer pour aller chercher les données. Et comme c'est un array, pas d soucis de lenteur.

Malheureusement, je ne peux pas le parcourir à ce moment du code... ou alors il faut que je modifie les appels aux fonctions

Je vais regarder ça. Un grand merci tout de même

hop hop hop ... si tu sais de quelles données tu as besoin, c'est donc encore plus simple

Cette partie du code te permet d'avoir le json

    Dim ScriptEngine As Object
    Set ScriptEngine = CreateObject("MSScriptControl.ScriptControl")
    With ScriptEngine
        .Language = "JScript"
        .AddCode "Object.prototype.element=function( i ) { return this[i] } ; "
    End With

    Dim data As Object
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", url, False
        .send
        json = Split(Split(.responsetext, "root.App.main = ")(1), "}}}};")(0) + "}}}}"
        Set data = ScriptEngine.Eval("(" + CStr(json) + ")")
    End With

à partir de là, tu peux accéder directement aux données, exemple pour le payoutRatio

data.context.dispatcher.stores.QuoteSummaryStore.summaryDetail.payoutRatio.raw

ou (*)

data.context.dispatcher.stores.QuoteSummaryStore.cashflowStatementHistory.cashflowStatements.0.endDate.raw
data.context.dispatcher.stores.QuoteSummaryStore.cashflowStatementHistory.cashflowStatements.0.totalCashFromFinancingActivities.raw

sauf que excel ne l'acceptera pas comme cela, il faut transformer context en element("context") car context est un mot réservé excel, et transformer l'indice qui varie de 0 à 3 (ici 0) en element(0)

C'est pour cela que j'ai ajouté la fonction prototype

Object.prototype.element=function( i ) { return this[i] }

(*) je rappelle qu'il s'agit d'une date unix à transformer

Désolé j'étais parti en congé. Du coup aération du cerveau !

Je reviens sur le sujet... Dans l'arbo JSON, j'utilise l'arbo suivante:

data.element("context").dispatcher.stores.QuoteTimeSeriesStore.timeSeries

Mais timeSeries n'existe pas toujours dans l'arbo...

J'aimerais faire un test sur ce niveau, du style:

If IsNull(data.element("context").dispatcher.stores.QuoteTimeSeriesStore.timeSeries) Then
...
End If

Mais ça ne fonctionne pas, il me renvoie : "Erreur d'exécution '438': Propriété ou méthode non gérée par cet objet"

Du coup je bloque... Un coup de main please ?

Bonjour,

Crée une fonction de ce type

Function test(data) As Boolean
    Dim flag As Boolean, objet As Object
    flag = False
    On Error GoTo fin
    Set objet = data.element("context").dispatcher.stores.QuoteTimeSeriesStore.trucmuche
    flag = True
fin:
    test = flag
End Function

qui te donnera Vrai ou Faux

Et appelle cette fonction comme suit

    If test(data) Then
        MsgBox "OK"
    Else
        MsgBox "Not OK"
    End If

En effet, cela fonctionne bien. Encore merci à toi

Si tout est ok, n'oublie pas de clore ce fil en cliquant sur

Tout n'est pas encore fixé. Mais le dernier problème n'est pas lié à ce sujet. Je vais créer un nouveau sujet