Discussion :

[jurassic pork]

hello Patrick,
avec les fonctions de la première réponse du premier lien de Al__22 post #2 qui utilise un objet ScriptControl on peut boucler sur les propriétés de ton fichier json de cette façon par exemple :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub test5()
    Dim fichier As String, sc As Object
    fichier = "F:\temp\test.json"
    Dim tabl As Object
    Dim Keys() As String
    json = lachaine(fichier)
    InitScriptEngine
    Set tabl = DecodeJsonString(json)
    Keys = GetKeys(tabl)
    For j = LBound(Keys) To UBound(Keys)
    Set Valeur = GetObjectProperty(tabl, Keys(j))
    Debug.Print "id : " & GetProperty(Valeur, "id") & " - Name : " & GetProperty(Valeur, "name")
    Next j
End Sub

Résultat :

id : 1099-99 - Name : Laboratoire de Hamm
id : 1143-99 - Name : Laboratoire de Zakk
id : 1102-99 - Name : Laboratoire de Lesh
id : 1099-100 - Name : Ferme Bauer
id : 1143-100 - Name : Ferme Gee
id : 1102-100 - Name : Ferme Barrett
id : 1099-101 - Name : Campement de McLain
id : 1143-101 - Name : Campement d'Habib
id : 1102-101 - Name : Campement de Patrick
etc ...

Edit : boucle avec un For Each :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
For Each Clef In Keys
Set Valeur = GetObjectProperty(tabl, Keys(Clef))
Debug.Print "id : " & GetProperty(Valeur, "id") & " - Name : " & GetProperty(Valeur, "name")
Next

Ami calmant, J.P

[Marc-L]

est ce que c'est pour supprimer ce qui pourrait se trouver avant le premier segment

Comme déjà indiqué dans ce post #15, c'était juste pour corriger le format de l'URL pas tout à fait à la norme …

Avec tes données du post #16, pas besoin de correction :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
Dim JSc As Object
 
Function jsonEval(jsonTXT$) As Object
 If JSc Is Nothing Then
Set JSc = CreateObject("ScriptControl")
    JSc.Language = "JScript"
    JSc.AddCode "function getKeys(jsonObj) { var keys = []; for (var i in jsonObj) { keys.push(i); } return keys; }"
 End If
     Set jsonEval = JSc.Eval("(" & jsonTXT & ")")
End Function
 
Function jsonAllColumns(TXT$)
              Dim oKeys As Object, oRoot As Object, C&, D&, L&, R&, S$(), V
              Set oRoot = jsonEval(TXT)
              Set oKeys = JSc.Run("getKeys", oRoot)
    If CallByName(oKeys, 0, VbGet) = "0" Then
            L = CallByName(oKeys, "length", VbGet) + 1
            S = Split(JSc.Run("getKeys", CallByName(oRoot, 0, VbGet)), ",")
            D = UBound(S) + 1
            ReDim V(1 To L, 1 To D)
            For C = 1 To D:  V(1, C) = S(C - 1):  Next
            On Error Resume Next
        For R = 2 To L
              Set oKeys = CallByName(oRoot, R - 2, VbGet)
            For C = 1 To D
                V(R, C) = CallByName(oKeys, V(1, C), VbGet)
            Next
        Next
         jsonAllColumns = V
    End If
        Set JSc = Nothing:  Set oKeys = Nothing:  Set oRoot = Nothing
End Function
 
Sub DemoAllColumns()
    Dim F%, S$, VA
    S = ThisWorkbook.Path & "\Jeu .json"
    If Dir(S) = "" Then Beep: Exit Sub
                         F = FreeFile
    Open S For Input As #F
      S = Input(LOF(F), #F)
                  Close #F
    Cells(4).CurrentRegion.Clear
    VA = jsonAllColumns(S)
    If Not IsArray(VA) Then Beep: Exit Sub
    Cells(4).Resize(UBound(VA), UBound(VA, 2)).Value = VA
End Sub

Première version avec les propriétés en dur et comme elles correspondent à des mots réservés du VBA,
il faut forcer leur casse toute en minuscules en déclarant des variables :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub DemoEnDur1()
        Dim oJS As Object, oElt As Object, R&, id%, name$
        Set oJS = CreateObject("ScriptControl"):  oJS.Language = "JScript"
        name = ThisWorkbook.Path & "\Jeu .json"
        If Dir(name) = "" Then Beep: Exit Sub
                                id = FreeFile
        Open name For Input As #id
         name = Input(LOF(id), #id)
                         Close #id
        Cells(4).CurrentRegion.Clear
        Application.ScreenUpdating = False
        R = 1
    For Each oElt In oJS.Eval(name)
        R = R + 1
        Cells(R, 4).Resize(, 2).Value = Array(oElt.id, oElt.name)
    Next
        Application.ScreenUpdating = True
        Set oJS = Nothing
End Sub

On peut très bien déclarer des variables bidons pour forcer la casse sans les utiliser dans le code
mais comme je n'aime pas gâcher on peut ensuite les supprimer, la casse restant en l'état !

Seconde version avec les propriétés en dur et sans déclarer de variable,
comme ces propriétés ont automatiquement leur première lettre en majuscule
car elles correspondent à des mots réservés du langage, il faut alors utiliser la fonction CallByName :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub DemoEnDur2()
        Dim oJS As Object, oElt As Object, R&, S$
        Set oJS = CreateObject("ScriptControl"):  oJS.Language = "JScript"
        S = ThisWorkbook.Path & "\Jeu .json"
        If Dir(S) = "" Then Beep: Exit Sub
                             R = 1
        Open S For Input As #R
          S = Input(LOF(R), #R)
                      Close #R
        Cells(4).CurrentRegion.Clear
        Application.ScreenUpdating = False
    For Each oElt In oJS.Eval(S)
        R = R + 1
        Cells(R, 4).Resize(, 2).Value = Array(CallByName(oElt, "id", VbGet), CallByName(oElt, "name", VbGet))
    Next
        Application.ScreenUpdating = True
        Set oJS = Nothing
End Sub

Il est à noter qu'un code avec les propriétés en dur est bien plus compact qu'une version scannant les noms des propriétés …

_________________________________________________________________________________________________________

Merci de cliquer sur pour chaque message ayant aidé puis sur pour clore cette discussion …

[patricktoulon]

re
a oui ca fuse dis moi je vais potasser mais je suis toujours dans l'analyse avec celui qui scanne les clé
et j'ai un soucis avec
il scanne le premier segment pour trouver toutes les clé "id,name,etc..."
mais j'ai des JSONS des fois qui n'ont pas tous le même nombre de clé dans les segments
je viens de faire le test si j'a joute une clé dans le premier il est pris en compte mais si je l'ajoute ailleurs ben c'est walouh!!!!
il faut trouver donc le moyen de scanner les segments afin de récupérer toutes les clé

je pensais que ca devais être plus simple qu'en string mais je me suis leurré

avec un regex je fait ca en rien du tout avec un pattern "(\D+) :"et un dico pour dé doublonner

mais le fait de pouvoir utiliser du javascript en vba me plait beaucoup surtout pour mon maileur et mon htmlediteur

je vais étudier tes dernières propositions

[patricktoulon]

re bon dans le dernier ca plante
sans doute un/serie de caractères mal digérés

[mercatog]

Patrick

pourquoi ne pas mettre le tout dans ton AddCode en Jscript

Exemple pour ton exemple

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
Sub DecodeJson()
Dim Sc As Object, Sf As Object, Res As Object, T As Object
Dim Fichier As String, Txt As String
Dim N As Long, i As Long, j As Long
Dim M As Integer
Dim Tb(), Elm, Itm
 
 
Fichier = "C:\Users\hp\Desktop\Sample.json"
Set Sf = CreateObject("Scripting.FileSystemObject")
Txt = Sf.OpenTextFile(Fichier, 1).ReadAll
Set Sf = Nothing
 
Set Sc = CreateObject("ScriptControl")
With Sc
    .Language = "JScript"
    .AddCode "function getLength(oJson) { return oJson.length; } "
    .AddCode "function getWidth(oJson) { return oJson[0].length; } "
    .AddCode "function getData(oJson) { var data = new Array(); var i = 0; var n=oJson.length; for(i=0; i<n; i++){data.push([]); for(var j in oJson[i]) {data[i].push(oJson[i][j]); }} return data; } "
 
    Set T = .Eval("(" + Txt + ")")
    Set Res = .Run("getData", T)
    N = .Run("getLength", T)
    M = .Run("getWidth", Res)
    Set T = Nothing
End With
Set Sc = Nothing
 
ReDim Tb(1 To N, 1 To M)
For Each Elm In Res
    i = i + 1
    For Each Itm In Elm
        j = j + 1
        Tb(i, j) = Itm
    Next Itm
    j = 0
Next Elm
Set Res = Nothing
 
[A1].Resize(N, M) = Tb
End Sub

[mercatog]

re

mais j'ai des JSONS des fois qui n'ont pas tous le même nombre de clé dans les segments
je viens de faire le test si j'a joute une clé dans le premier il est pris en compte mais si je l'ajoute ailleurs ben c'est walouh!!!!
il faut trouver donc le moyen de scanner les segments afin de récupérer toutes les clé

Voila toujours en javascript

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
Sub DecodeJson()
Dim Sc As Object, Sf As Object, Res As Object, T As Object
Dim Fichier As String, Txt As String
Dim N As Long, i As Long, j As Long
Dim M As Integer
Dim Tb(), Elm, Itm
 
 
Fichier = "C:\Users\hp\Desktop\Sample.json"
Set Sf = CreateObject("Scripting.FileSystemObject")
Txt = Sf.OpenTextFile(Fichier, 1).ReadAll
Set Sf = Nothing
 
Set Sc = CreateObject("ScriptControl")
With Sc
    .Language = "JScript"
    .AddCode "function getLength(oJson) { return oJson.length; } "
    .AddCode "function getWidth(oJson) {var m=0; var i=0; for (i=0; i<oJson.length;i++){if (oJson[i].length > m) {m=oJson[i].length;}} return m; } "
    .AddCode "function getData(oJson) { var data = new Array(); var i = 0; var n=oJson.length; for(i=0; i<n; i++){data.push([]); for(var j in oJson[i]) {data[i].push(oJson[i][j]); }} return data; } "
 
    Set T = .Eval("(" + Txt + ")")
    Set Res = .Run("getData", T)
    N = .Run("getLength", T)
    M = .Run("getWidth", Res)
    Set T = Nothing
End With
Set Sc = Nothing
 
ReDim Tb(1 To N, 1 To M)
For Each Elm In Res
    i = i + 1
    For Each Itm In Elm
        j = j + 1
        Tb(i, j) = Itm
    Next Itm
    j = 0
Next Elm
Set Res = Nothing
 
[A1].Resize(N, M) = Tb
End Sub

PS. valable pour les json qui ont la même configuration que l'exemple donné

Edit correction coquille dans M

[patricktoulon]

re
Bonjour Mercatog
puré toi quand tu envoie tu fait pas semblant
dire que avant je faisait comme ca pour trouver toute les clés
et je vous interdis de rigoler hein !!!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Function getAllProperties(txt As String) As Variant
    Dim Matches, ReG, D, P
    Set ReG = CreateObject("VBScript.RegExp")
    Set ReG2 = CreateObject("VBScript.RegExp")
    Set D = CreateObject("Scripting.Dictionary")
    With ReG
        .Global = True: .Pattern = """(\D+)"":": .IgnoreCase = True 'le pattern indique une suite  de 1 a 10 caractères suivi de ":" et permet même les clé avec plusieurs mots
        Set Matches = .Execute(txt)
        ReDim tablo(Matches.Count): i = 0
        For Each Match In Matches
            ReG2.Pattern = "([a-z|( )]+)" 'on ne récupère uniquement les caractères de A a Z dans les properties trouvées avec un reg2 
            Set P = ReG2.Execute(CStr(Match)) '--------
            If Not D.Exists(Trim(P(0))) Then D(Trim(P(0))) = Trim(P(0)): tt = tt & Trim(P(0)) & "|" 'on le met dans le dico
        Next
    End With
     getAllProperties = Split(Trim(tt), "|")
    Set ReG = Nothing: Set ReG2 = Nothing: Set D = Nothing
End Function
 
 
Sub test()
    Dim X, chemin As String, T As String
    chemin = "C:\Users\polux\Downloads\objective_names.json"
    X = FreeFile
    Open chemin For Input As #X
    T = Input(LOF(X), #X)
    Close #X
    T = "[" & Split(Split(T, "[")(1), "]")(0) & "]"'correction de caractères non désirés en début de fichier 
    clé = getAllProperties(T)
 
        Debug.Print Join(clé, ",")
 
End Sub

Mercatog je vais regarder ton exemple

un dernier petit détail j'aimerait en entête les nom des clés
avec ton model on récupère les valeur des clés si je comprends bien
j'ai aussi ajouter le split de Marc-L sur le Txt des caractères bizarre se trouvaient devant le 1er "[" même si on ne les voit pas dans le fichier
mais déjà les fonctions javascript cotton

[patricktoulon]

re

bon j'essai de disséquer le getdata (construction du tableau si j'ai bien compris )
.AddCode "function getData(oJson) { var data = new Array(); var i = 0; var n=oJson.length; for(i=0; i<n; i++){data.push([]); for(var j in oJson[i]) {data[i].push(oJson[i][j]); }} return data; } "

rouge creation de l'array
vert donne le nombre de segment
orange boucle 1 ajout de ligne correspondant a l'index de l'item dans la boucle
bleu boucle 2 imbriquée dans boucle 1 dans cette ligne on ajoute une colonne a chaque occurrence de clé

au final la fonction =return la variable data

c'est bien cela ??

[Marc-L]

j'ai aussi ajouter le split de Marc-L sur le Txt des caractères bizarre se trouvaient devant le 1er "[" même si on ne les voit pas dans le fichier

Et pourtant je t'ai demandé explicitement et ce, plusieurs fois, de joindre le fichier ‼
Car si tu testais comme moi avec une copie des données du post #16 enregistrée via le Bloc-notes tu n'aurais pas de souci !
Evidemment ton vrai fichier est certainement encodé en utf-8 et j'aurais proposé un code en tenant compte …

Encore une fois, tout dépend si la norme est bien respectée, ayant aussi rencontré des fichiers json like mais pas tout à fait,
un peu comme le Canada Dry, cela en a l'aspect mais ce n'est pas vraiment cela !

Tes données du post #16 représente le cas le plus facile : respect de la norme, tableau simple entrée avec juste des titres de colonnes.
Je suis tombé sur des json à double entrée, titres de lignes et de colonnes avec parfois un tableau imbriqué dans un autre …
Sans compter effectivement ceux avec un nombre de colonnes fluctuant d'une ligne à une autre !

Avec tes données du post #16, même en mode automatique pas besoin du JScript,
le VBA standard suffit à fournir le même résultat et tout aussi rapidement :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub DemoSplitAuto()
      Const DL = """:""", GU = """"
        Dim C&, D&, F$, R&, SD$(), SP$(), VA$()
        F = ThisWorkbook.Path & "\Jeu .json"
        If Dir(F) = "" Then Beep: Exit Sub
                                  C = FreeFile
             Open F For Input As #C
        SP = Split(Input(LOF(C), #C), "{""")
                           Close #C
        If UBound(SP) < 1 Then Beep: Exit Sub
        SD = Split(SP(1), ",")
         D = UBound(SD)
        ReDim VA(1 To UBound(SP) + 1, 1 To D)
        For C = 1 To D:  VA(1, C) = Replace$(Split(SD(C - 1), DL)(0), GU, ""):  Next
    For R = 2 To UBound(VA)
                               SD = Split(SP(R - 1), DL)
        For C = 1 To D:  VA(R, C) = Split(SD(C), GU)(0):  Next
    Next
        Cells(1).CurrentRegion.Clear
        Cells(1).Resize(UBound(VA), UBound(VA, 2)).Value = VA
End Sub

Edit : bien vu Mercatog : & !

[patricktoulon]

re
oui Marc
de toute facon pour un json a 1 entrée je garde ton split ca mange pas de pain de le mettre tout le temps

après oui Mercatog gère en JavaScript et toi en vba
mais bon dans l'ensemble les deux méthodes valent le coup
il faut que je digère tout ca
en tout cas pouce a tout les deux
je me suis amusé aussi a le faire en string cet après midi par des fonctions séparées
il faut prendre en compte que cet exemple de json est relativement simple

[mercatog]

Bonjour Patrick, Marc, le forum

Patrick, ton explication du code jscript est claire.

Le json en exemple est le plus simple du monde et personnellement, dans ce cas, utiliser vba est aisé. et 3 pour Marc

Pour mon exemple c'était pour découvrir les possibilités du scriptcontrol au cas où. Je ne connais presque rien au javascript et c'était ma première découverte suite au premier code de Patrick et les liens données par Al__22 et Oliv-. J'ai aussi trouvé un fonction javascript JSON.parse() que je n'ai pu intégrer faute de connaissance des possibilités du langage

Ayant suivi la discussion, je me suis intéresse au fait qu'on pourra formater au préalable les données du json en javascript.


Pour les json complexe, une fonction récursive est nécessaire du fait qu'aux clés des objets json on pourra trouver aussi bien des valeurs, des tableaux ou même des "sous-objets" json eux même composés de valeurs, tableaux ou "sous-sous-objets". Sorte d'arbre: Dans ces cas on est plus en 2 dimensions.

[jurassic pork]

hello,
en pièce jointe un fichier json plus difficile à "éplucher"

[Marc-L]

Pour les json complexe, une fonction récursive est nécessaire du fait qu'aux clés des objets json on pourra trouver aussi bien des valeurs, des tableaux ou même des "sous-objets" json eux même composés de valeurs, tableaux ou "sous-sous-objets". Sorte d'arbre: Dans ces cas on est plus en 2 dimensions.

Oui j'ai eu affaire à ce type de données, j'ai dû d'abord créer un mini extracteur de structure pour mieux l'appréhender …

[jurassic pork]

hello,
avec le module de classe cJobject de Bruce Mcpherson qui se trouve dans les fichiers de son site (il faut un peu fouiner dans les fichiers proposés en téléchargement dans le site et utiliser d'autres modules dont il dépend), on peut remplir un arbre de type activeX Microft treeview Control version 6.0 avec le contenu du fichier json test_recursif.json en utilisant ce code par exemple :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Sub LireJson()
Dim jo As New cJobject
Dim ChaineJson As String
MonArbreJson.Nodes.clear
ChaineJson = lachaine("F:\temp\test_recursif.json")
Set jo = jo.init(Nothing).deSerialize(ChaineJson)
jo.toTreeView MonArbreJson
End Sub

voici le résultat :


et voici ce qu'affiche notepad++ pour le fichier :


Ami calmant, J.P

[GESCOM2000]

J'ai mis pas mal de temps a manipuler les JSON avec MSXML2.XMLHTTP

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 Set ChercheValeur= VBA.CallByName(JSON.LesValeursItem0, "0", VbGet) 'Va chercher dans les items du Json
          Sheets("Feuil1").Cells(1, 1).Value = ChercheValeur.ValeurTrouver