Disséquer un fichier json avec un scriptcontrolobject

Version imprimable

bonjour a tous

la question ayant été posé aujourd'hui et travaillant en string habituellement j'ai decidé de me mettre un peu a exploiter le scriptcontrol
voila je voudrais diséquer un fichier JSON
(alors oui il y a des sources partout sur le net mais il manque un e peu de pédagogie dans ces exemples bref je patoge

voila ce que j'ai réussi a comprendre jusque la :ce qu'il me manque c'est l'exploitation de l'arrays des keys

si quelqu'un a des exemples avec explication je suis preneur
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 Sub decodejson() Dim sc As Object, obj As Variant 'ouverture du fichier Dim laChaine As String, x, fichier As String fichier = "C:\Users\polux\Downloads\objective_names.json" x = FreeFile Open fichier For Input As #x laChaine = Input(LOF(x), #x) Close #x 'partie scriptcontrol en javascript Set sc = CreateObject("ScriptControl") sc.Language = "JScript" sc.AddCode "function getProperty(jsonObj, propertyName) { return jsonObj[propertyName]; } " sc.AddCode "function getKeys(jsonObj) { var keys = new Array(); for (var i in jsonObj) { keys.push(i); } return keys; } " 'exploitation Set tabl = sc.Eval("(" + laChaine + ")")'on exécute la commande native javascript "eval" sans passer par une fonction Set Keys = sc.Run("getKeys", tabl) ' je voudrais lister mes élément ici avec leur id et leur Name dans une boucle End Sub
un exemple de json raccourci en longueur mais valide

Citation:

[{"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"},{"id":"1099-102","name":"Académie de O'del"},{"id":"1143-102","name":"Académie de Kay'li"},{"id":"1102-102","name":"Académie de Y'lan"},{"id":"1099-104","name":"Nécropole éternelle"},{"id":"1143-104","name":"Nécropole impérissable"},{"id":"1102-104","name":"Nécropole immortelle"},{"id":"1099-105","name":"Dépôt Vilebrequin"},{"id":"1143-105","name":"Dépôt Engrenage"},{"id":"1102-105","name":"Dépôt Bougie"},{"id":"1099-106","name":"Crypte embrasée"},{"id":"1143-106","name":"Crypte torride"},{"id":"1102-106","name":"Crypte cuisante"},{"id":"1099-107","name":"- Frontière"},{"id":"1143-107","name":"- Frontière"},{"id":"1102-107","name":"- Frontière"},{"id":"1099-108","name":"- Frontière"},{"id":"1143-108","name":"- Frontière"},{"id":"1102-108","name":"- Frontière"},{"id":"1099-109","name":"Refuge de Roy"},{"id":"1143-109","name":"Refuge d'Olivier"},{"id":"1102-109","name":"Refuge de Norfolk"},{"id":"1099-110","name":"Avant-poste dévasté"},{"id":"1143-110","name":"Avant-poste délabré"},{"id":"1102-110","name":"Avant-poste ravagé"},{"id":"1099-113","name":"Rempart stoïque"},{"id":"1143-113","name":"Rempart durci"},{"id":"1102-113","name":"Rempart impassible"},{"id":"1099-114","name":"Palais du balbuzard"},{"id":"1143-114","name":"Palais de la pie-grièche"},{"id":"1102-114","name":"Palais du circaète"},{"id":"1099-115","name":"Antre de Boettiger"},{"id":"1143-115","name":"Antre de Berdrow"},{"id":"1102-115","name":"Antre de Hughe"},{"id":"1099-116","name":"Puits du Souffle-poussière"},{"id":"1143-116","name":"Puits du Dernier-soupir"},{"id":"1102-116","name":"Puits du Rêve-brisé"},{"id":"1099-117","name":"- Citadelle"},{"id":"1143-117","name":"- Citadelle"},{"id":"1102-117","name":"- Citadelle"},{"id":"94-62","name":"Temple des prières perdues"}]

merci pour les retours

30/11/2016, 14h41
Al__22

Bonjour Patrick

Je sais pas si ca pourras t'aider mais ils en parlent pas mal sur Stackoverflow :
http://stackoverflow.com/questions/6...n-in-excel-vba
http://stackoverflow.com/questions/1...y-in-excel-vba
http://stackoverflow.com/questions/5...on-object-loop

Et sinon il y a ashutosh qui en parle sur son blog (et que je trouve plutôt pertinent) :
http://ashuvba.blogspot.fr/2014/09/j...rough-net.html
30/11/2016, 15h05
patricktoulon

re

re
Bonjour Al_22
oui je l'ai ai tous vu ces liens mais aucun n'explique celui de truc machinsoch est un exemple mais avec des fonction concernant un treeview si bien que l'on détermine plus quoi sert a quoi

pertinent je sais pas mais en tou cas je ne veux pas une usine a gaz sachant que "eval" que l'on pourrait comparer a "évaluate" en vba est sensé découper le code du json

parti de la il me faut juste l'exploitation du tableau

les fonction getproperty. sont intéressantes mais si on ne peut pas manipuler le tableau par vba c'est pas la peine
en l'occurrence son code en entier adapter au json que j'ai donné en exemple plante sur plusieurs ligne si bien que j'ai abandonner l'idée de me servir de son code
la fonction getkeys est sensé me retourner le tableau
30/11/2016, 15h10
Oliv-

Salut,
un JSON c'est une base de donnée dans un string.

Moi j'utilise ce parser là adapté au vba

https://github.com/samgerene/VBJSOND...ource/JSON.bas
30/11/2016, 15h15
Oliv-

Tu peux utiliser cet outil en ligne aussi
https://jsonformatter.curiousconcept.com/

je vais t'envoyer un descriptif bien fait dès que je l'aurai retrouvé
30/11/2016, 15h22
Al__22

Citation:

Envoyé par patricktoulon

re
Bonjour Al_22
oui je l'ai ai tous vu ces liens mais aucun n'explique celui de truc machinsoch est un exemple mais avec des fonction concernant un treeview si bien que l'on détermine plus quoi sert a quoi

pertinent je sais pas mais en tou cas je ne veux pas une usine a gaz sachant que "eval" que l'on pourrait comparer a "évaluate" en vba est sensé découper le code du json

Il m'avait semblé comprendre en lisant en diagonale que l'exemple de soch permet de mettre chacune des données du JSON dans un treeview. Donc en remplaçant les bouts de treeview par du vieux VBA tu pourrais retomber sur tes pattes non ? :mouarf:

Enfin je m'avance peut être un peu vu que je peux pas vérifier ceci (pas de fichier JSON sous la main)
30/11/2016, 15h25
patricktoulon

re

salut oliv ca faisait longtemps ;)

oui des solution il y en a foison je veux juste apprendre a exploiter ce script control pour cet exercice
après ton exemple est peut être parfait mais il fait un peu usine a gaz d'ailleurs je me suis perdu entre les tuyaux de butane et de propane
après des converters en ligne il y en a pas mal aussi

perso je voudrais réussir a métriser le script control en vba pour les json

sinon c'st pas marrant de prendre quelque chose de tout fait

c'est pas la destination mais le chemin qui est intéressant
30/11/2016, 15h29
Marc-L

Salut !

Patrick, j'ai deux voies :

• une automatique extrayant l'intégralité des données du fichier pour peu qu'il respecte la norme;

• une voie où dans le code sont indiqués les titres des colonnes ou sinon est directement codée chaque propriété …

_________________________________________________________________________________________________________
Je suis Paris, Nice, Bruxelles, Charlie, …
30/11/2016, 15h30
patricktoulon

re

re
@AL_22

Citation:

Il m'avait semblé comprendre en lisant en diagonale que l'exemple de soch permet de mettre chacune des données du JSON dans un treeview. Donc en remplaçant les bouts de treeview par du vieux VBA tu pourrais retomber sur tes pattes non ? :mouarf:

Enfin je m'avance peut être un peu vu que je peux pas vérifier ceci (pas de fichier JSON sous la main)

d'après ce que j ai lu c'est le contraire il prend s d'un tree view pour changer le json et vise et versa ce qui me complique beaucoup la compréhension de son code

et moi quand il n'y a pas d'explication je zappe

perso quand je partage j'explique du mieux que je peux le pourquoi du comment sinon on tombe dans du tout fait maison et ca m'intéresse pas

je veux comprendre avant tout
30/11/2016, 15h33
Marc-L

Patrick,

voir mon précédent post et si tu peux joindre le fichier source …

la base est là : http://json.org/json-fr.html

Je ne pense pas qu'il y ait de façon simple de l'aborder côtè VBA , voir les exemples de ce dernie lien en XMLHttpRequest ou ajax
Code:

1 2 3 4 5 6 7 8 9 10 var courses = {}; var xmlhttp = new XMLHttpRequest(); xmlhttp.open("GET", url, true); xmlhttp.onreadystatechange = function () { if (xmlhttp.readyState == 4 && xmlhttp.status == 200){ courses = JSON.parse(xmlhttp.responseText); } }; xmlhttp.send(null);

30/11/2016, 15h40
patricktoulon

re

Citation:

Envoyé par Marc-L

Salut !

Patrick, j'ai deux voies :

• une automatique extrayant l'intégralité des données du fichier pour peu qu'il respecte la norme;

• une voie où dans le code sont indiqués les titres des colonnes ou sinon est directement codée chaque propriété …

_________________________________________________________________________________________________________
Je suis Paris, Nice, Bruxelles, Charlie, …

re oui tu peux developper??

après la norme(voir format) ben c'est balo il y en a 6 dont 4 sont exploités dans le lien du converter de oliv dans son post plus haut

mais tous travaille avec "[]" pour le parent et "{.....}" les éléments

donc eval devrait me donner le tableau et c'est pas le cas pourquoi pourquoi

merci des retours les gards
30/11/2016, 15h46
Marc-L

Joins le fichier complet et dis-moi si tu veux tout extraire automatiquement
ou garder le contrôle en extrayant une partie des données selon les en-têtes
ou en codant directement les propriétés comme on l'a déjà réalisé
lors d'une discussion sur la musique de canassons …
30/11/2016, 15h47
patricktoulon

re

re
oui merci oliv pour la base
ca confirme ce que je disais
a l'exception "[]" qui peut etre le parent ou un array

dans tout les cas sur l'exemple de json que j'ai donné plus haut c'est un array contenant tout les élément
j'en conclu donc que si je fait un eval il me donnera la totale puisqu'il y en a qu'un et c'est donc le parent de tout les "{.....}"
dans ce cas la c'est les enfants que je voudrais pourvoir boucler

Dans l'exemple suivant que j'ai publié sur un forum étranger - l'URL source n'étant plus valide … - mais
je me rappelle que le format n'était pas tout à fait à la norme comme tu peux le constater
dans la ligne de code n°47 pour l'appel de la fonction :

Code:

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
47
48
49
50
51
52
53
54
Dim JSc As Object
 
Function TextRequest$(URL$)
    With CreateObject("MSXML2.XMLHttp")
        .Open "GET", URL, False
        .setRequestHeader "DNT", "1"
         On Error Resume Next
        .send
         If .Status = 200 Then TextRequest = .responseText Else Beep
    End With
End Function
 
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, SP$()
          Set oRoot = jsonEval(TXT)
          Set oKeys = JSc.Run("getKeys", oRoot)
If CallByName(oKeys, 0, VbGet) = "0" Then
    L& = CallByName(oKeys, "length", VbGet) + 1
    SP = Split(JSc.Run("getKeys", CallByName(oRoot, 0, VbGet)), ",")
    D& = UBound(SP) + 1
    ReDim VT(1 To L, 1 To D)
    For C& = 1 To D:  VT(1, C) = SP(C - 1):  Next
        On Error Resume Next
    For R& = 2 To L
           Set oKeys = CallByName(oRoot, R - 2, VbGet)
        For C = 1 To D
            VT(R, C) = CallByName(oKeys, VT(1, C), VbGet)
        Next
    Next
         jsonAllColumns = VT
End If
    Set JSc = Nothing:  Set oKeys = Nothing:  Set oRoot = Nothing
End Function
 
Sub Demo()
    T$ = TextRequest("http://casadopaodequeijo.com.br/resource/scripts/custom-map-default.js")
    If T = "" Then Exit Sub
    VA = jsonAllColumns("[" & Split(Split(T, "[")(1), "]")(0) & "]")
    If Not IsArray(VA) Then Beep: Exit Sub
         ActiveSheet.UsedRange.Clear
    With Cells(1).Resize(UBound(VA), UBound(VA, 2))
        .Value = VA
        .Columns.AutoFit
    End With
End Sub

_________________________________________________________________________________________________________

Merci de cliquer sur :plusser: si vous appréciez ce code …

Citation:

Envoyé par Marc-L

Joins le fichier complet et dis-moi si tu veux tout extraire automatiquement
ou garder le contrôle en extrayant une partie des données selon les en-têtes
ou en codant directement les propriétés comme on l'a déjà réalisé
lors d'une discussion sur la musique de canassons …

ah!!! je savais bien que l'on avais fait un truc du genre avec les bourricots c'était toi d'ailleurs qui avais fait cette proposition
je le trouve plus je ne sais même plus sur quelle discussion ca avait été évoqué

ou mon but c'est soit d'obtenir un tableau
soit effectivement avoir aussi les propriétés via une boucle sur les items
item(1).id
item(1).name
etc....
en gros la base
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 Function lachaine(chemin) As String x = FreeFile Open chemin For Input As #x lachaine = Input(LOF(x), #x) Close #x End Function Sub test5() Dim fichier As String, sc As Object fichier = "C:\Users\polux\Downloads\objective_names.json" Dim o json = lachaine(fichier) Set sc = CreateObject("scriptcontrol") sc.Language = "JScript" 'javascript dans le scriptcontrol sc.AddCode "function getProperty(jsonObj, propertyName) { return jsonObj[propertyName]; } " sc.AddCode "function getKeys(tabl) { var keys = new Array(); for (var i in tabl) { keys.push(i); } return keys; } " 'VBA Set tabl = sc.Eval("(" + json + ")") 'ceci est sensé couper Set Keys = sc.Run("getKeys", tabl) Debug.Print Keys(1) 'methode non géré par cet object j'ai tout essayé End Sub
le json pour les essais c'est

Citation:

[{"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"},{"id":"1099-102","name":"Académie de O'del"},{"id":"1143-102","name":"Académie de Kay'li"},{"id":"1102-102","name":"Académie de Y'lan"},{"id":"1099-104","name":"Nécropole éternelle"},{"id":"1143-104","name":"Nécropole impérissable"},{"id":"1102-104","name":"Nécropole immortelle"},{"id":"1099-105","name":"Dépôt Vilebrequin"},{"id":"1143-105","name":"Dépôt Engrenage"},{"id":"1102-105","name":"Dépôt Bougie"},{"id":"1099-106","name":"Crypte embrasée"},{"id":"1143-106","name":"Crypte torride"},{"id":"1102-106","name":"Crypte cuisante"},{"id":"1099-107","name":"- Frontière"},{"id":"1143-107","name":"- Frontière"},{"id":"1102-107","name":"- Frontière"},{"id":"1099-108","name":"- Frontière"},{"id":"1143-108","name":"- Frontière"},{"id":"1102-108","name":"- Frontière"},{"id":"1099-109","name":"Refuge de Roy"},{"id":"1143-109","name":"Refuge d'Olivier"},{"id":"1102-109","name":"Refuge de Norfolk"},{"id":"1099-110","name":"Avant-poste dévasté"},{"id":"1143-110","name":"Avant-poste délabré"},{"id":"1102-110","name":"Avant-poste ravagé"},{"id":"1099-113","name":"Rempart stoïque"},{"id":"1143-113","name":"Rempart durci"},{"id":"1102-113","name":"Rempart impassible"},{"id":"1099-114","name":"Palais du balbuzard"},{"id":"1143-114","name":"Palais de la pie-grièche"},{"id":"1102-114","name":"Palais du circaète"},{"id":"1099-115","name":"Antre de Boettiger"},{"id":"1143-115","name":"Antre de Berdrow"},{"id":"1102-115","name":"Antre de Hughe"},{"id":"1099-116","name":"Puits du Souffle-poussière"},{"id":"1143-116","name":"Puits du Dernier-soupir"},{"id":"1102-116","name":"Puits du Rêve-brisé"},{"id":"1099-117","name":"- Citadelle"},{"id":"1143-117","name":"- Citadelle"},{"id":"1102-117","name":"- Citadelle"},{"id":"94-62","name":"Temple des prières perdues"},{"id":"96-62","name":"Temple des prières perdues"},{"id":"95-62","name":"Temple des prières perdues"},{"id":"94-35","name":"Vert-bruyère"},{"id":"96-35","name":"Bruyerouge"},{"id":"95-35","name":"Bruyazur"},{"id":"94-103","name":"- Frontière"},{"id":"96-103","name":"- Frontière"},{"id":"95-103","name":"- Frontière"},{"id":"94-32","name":"Collines d'Etheron"},{"id":"96-32","name":"Collines d'Askalion"},{"id":"95-32","name":"Collines Shadaran"},{"id":"94-33","name":"Baie des rêves"},{"id":"96-33","name":"Baie de l'Ascension"},{"id":"95-33","name":"Baie du Noir déclin"},{"id":"94-65","name":"Belvédère du Verger"},{"id":"96-65","name":"Belvédère du Verger"},{"id":"95-65","name":"Belvédère du Verger"},{"id":"94-38","name":"Longuevue"},{"id":"96-38","name":"Boisrefuge"},{"id":"95-38","name":"Colline ensoleillée"},{"id":"94-39","name":"L'Epée divine"},{"id":"96-39","name":"Le Heaume spirituel"},{"id":"95-39","name":"Bras du Titan"},{"id":"94-64","name":"Domaine de Bauer"},{"id":"96-64","name":"Domaine de Bauer"},{"id":"95-64","name":"Domaine de Bauer"},{"id":"94-37","name":"- Garnison"},{"id":"96-37","name":"- Garnison"},{"id":"95-37","name":"- Garnison"},{"id":"94-53","name":"Refuge de Valvert"},{"id":"96-53","name":"Refuge de Valrouge"},{"id":"95-53","name":"Refuge de Bleuval"},{"id":"94-111","name":"- Citadelle"},{"id":"96-111","name":"- Citadelle"},{"id":"95-111","name":"- Citadelle"},{"id":"94-112","name":"- Frontière"},{"id":"96-112","name":"- Frontière"},{"id":"95-112","name":"- Frontière"},{"id":"94-52","name":"Espoir d'Arah"},{"id":"96-52","name":"Savoir divin"},{"id":"95-52","name":"Saut de la Foi"},{"id":"94-51","name":"Heaume astral"},{"id":"96-51","name":"Bosquet étoilé"},{"id":"95-51","name":"Havre gris"},{"id":"94-66","name":"Côte du couteau"},{"id":"96-66","name":"Côte du couteau"},{"id":"95-66","name":"Côte du couteau"},{"id":"94-34","name":"Pavillon du Vainqueur"},{"id":"96-34","name":"Fief du Champion"},{"id":"95-34","name":"Pavillon du Héros"},{"id":"94-36","name":"Lac bleu"},{"id":"96-36","name":"Lac vert"},{"id":"95-36","name":"Lac rouge"},{"id":"94-50","name":"Basses terres d'Eau-Azur"},{"id":"96-50","name":"Basses terres d'Eau-Verdoyante"},{"id":"95-50","name":"Basses terres de Rubicon"},{"id":"94-63","name":"Vallon de bataille"},{"id":"96-63","name":"Vallon de bataille"},{"id":"95-63","name":"Vallon de bataille"},{"id":"94-40","name":"Flanc de falaise"},{"id":"96-40","name":"Repaire de l'aube"},{"id":"95-40","name":"Sommet de Hautcrag"},{"id":"968-98","name":"Tunnel de guivre"},{"id":"968-96","name":"Aéroport"},{"id":"968-82","name":"Réacteur de Tonnecrevasse"},{"id":"968-93","name":"Forge"},{"id":"968-80","name":"Réacteur du Temple surdimensionné"},{"id":"968-94","name":"Sanctuaire"},{"id":"968-90","name":"Autel"},{"id":"968-97","name":"Atelier"},{"id":"968-81","name":"Réacteur de la Forteresse aride"},{"id":"968-83","name":"Réacteur du Pic de Pierregard"},{"id":"968-95","name":"Clocher"},{"id":"968-91","name":"Observatoire"},{"id":"968-78","name":"Temple surdimensionné"},{"id":"968-88","name":"Forteresse aride"},{"id":"968-89","name":"Perchoir de Tytone"},{"id":"968-79","name":"Tonnecrevasse"},{"id":"968-85","name":"Réacteur du Perchoir de Tytone"},{"id":"968-77","name":"Aiguille infernale"},{"id":"968-87","name":"Pic de Pierregard"},{"id":"968-84","name":"Réacteur de l'Aiguille infernale"},{"id":"968-92","name":"Statue"},{"id":"38-11","name":"Corniche d'Aldon"},{"id":"38-1","name":"- Belvédère"},{"id":"38-15","name":"Ravin de Langor"},{"id":"38-3","name":"- Basses terres"},{"id":"38-17","name":"Faille de Mendon"},{"id":"38-7","name":"Passage Danelon"},{"id":"38-9","name":"Château Brumepierre"},{"id":"38-5","name":"Montée de Pangloss"},{"id":"38-21","name":"Ravin de Durios"},{"id":"38-20","name":"Flanc de Veloka"},{"id":"38-14","name":"Petit ravin de Klovan"},{"id":"38-13","name":"Bourbier de Jerrifer"},{"id":"38-6","name":"Forêt rasée de Speldan"},{"id":"38-2","name":"- Vallée"},{"id":"38-12","name":"Piste du ruisseau sauvage"},{"id":"38-16","name":"Lac Quentin"},{"id":"38-22","name":"Falaise de Bravost"},{"id":"38-19","name":"Percée de Gardogre"},{"id":"38-4","name":"Clairière de Golanta"},{"id":"38-8","name":"Bois d'Ombreclair"},{"id":"38-10","name":"Carrière du voleur"},{"id":"38-18","name":"Col d'Anzalias"}]

Citation:

Envoyé par patricktoulon

je ne sais même plus sur quelle discussion ca avait été évoqué

Je crois bien dans cette discussion de Sebphyto et voir aussi page suivante le post #87 …

Là les propriétés sont en dur dans les codes …

Je me rappelle pour le forum du post #15 quelqu'un a utilisé le RegExp …
Du coup dans ton exemple pour seulement deux colonnes déjà je resterais dans le B-A-BA du VBA,
à savoir un Split de Split assez Chrüterchraft, un classique à la romaine, hein Patrick !
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 Sub DemoSplit() Dim F$, R&, SPQ$(), VA$() F = ThisWorkbook.Path & "\Jeu .json" If Dir(F) = "" Then Beep: Exit Sub R = FreeFile Open F For Input As #R SPQ = Split(Input(LOF(R), #R), "{""id"":""") Close #R If UBound(SPQ) < 1 Then Beep: Exit Sub ReDim VA(1 To UBound(SPQ), 1 To 2) For R = 1 To UBound(VA) VA(R, 1) = Split(SPQ(R), """")(0) VA(R, 2) = Split(Split(SPQ(R), ":""")(1), """")(0) Next Cells(1).CurrentRegion.Clear [A2].Resize(UBound(VA), 2).Value = VA End Sub

re
le but n'est pas de trouver la meilleur solution pour ce cas present de json
d'ailleur a jour avec le Ba Ba comme tu dis je préfère largement ma version avec les replace que j'ai proposé dans la question d'un demandeur qui m'a donner envie d'aller chercher ailleur

ensuite
ces deux exemple illustre bien mon soucis

en effet dans le 1er exemple en dur et en gerant la fonction par vba
si on débloque le 2d jsonstring ca plante
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 Sub TestJSONParsingWithVBACallByName() Dim SC As Object Set SC = CreateObject("ScriptControl") SC.Language = "JScript" Dim jsonString As String jsonString = "{'key1':'value1','key2':'value2'}" 'jsonString = "[{'key1':'value1','key2':'value2'},{'key3':'value3','key4':'value4'}]" Dim objJSON As Object Set objJSON = SC.Eval("(" + jsonString + ")") Debug.Print VBA.CallByName(objJSON, "key1", VbGet) '= "value1" Debug.Print VBA.CallByName(objJSON, "key2", VbGet) '= "value2" End Sub
ok alors essayons le tableau mais dans le debug j'ai l'object en retour
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 Sub TestJSONParsingWithVBACallByName2() Dim SC As Object Dim objJSONArray As Object Dim jsonStringArray As String Set SC = CreateObject("ScriptControl") SC.Language = "JScript" jsonStringArray = "[ {'key1':'value1','key2':'value2'}, 4567]" Set objJSONArray = SC.Eval("(" + jsonStringArray + ")") Debug.Print "nombre d'element = " & VBA.CallByName(objJSONArray, "length", VbGet) '= "2" Debug.Print VBA.CallByName(objJSONArray, "0", VbGet) Debug.Print VBA.CallByName(objJSONArray, "1", VbGet) End Sub
voila alors peut etre consilier les deux dabors le array et passer chaque element au vbget
mais je sais pas faire

dire que je l'avais fait avec ADO dans un object xml mais je l'ai perdu en formatant

30/11/2016, 20h08
Marc-L

Si tu suis bien la discussion en lien de Sebphyto pour une utilisation en dur
ou mon code du post #15 pour une version automatique c'est sans souci !

J'ai testé en dur avec les données du post #16, aucun souci en respectant la casse des propriétés …
Et je suis sûr qu'en automatique via mon code du post #15 cela fonctionnera aussi bien !
30/11/2016, 22h18
patricktoulon

re

re
apres lecture du post 15 je l'ai raté car on se croise de temps en temps
bon avec oroot et sp je comprends mieux il me semble que c'est ce que je cherche
ne pas avoir a nomer les cle de valeur
parcontre j'ai une hesitation sur le but de ceci:

Code:

VA = jsonAllColumns("[" & Split(Split(T, "[")(1), "]")(0) & "]")

est ce que c'est pour supprimer ce qui pourrait se trouver avant le premier segment (titre,parametre etc....???? perso je vois que ca

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:

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 :

Citation:

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:

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

Citation:

Envoyé par patricktoulon

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:

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:

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:

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 :plusser: pour chaque message ayant aidé puis sur :resolu: pour clore cette discussion …

01/12/2016, 10h32
patricktoulon

re

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
01/12/2016, 11h29
patricktoulon

1 pièce(s) jointe(s)

re

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

Patrick

pourquoi ne pas mettre le tout dans ton AddCode en Jscript

Exemple pour ton exemple

Code:

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

Citation:

Envoyé par patricktoulon

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:

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

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:

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

01/12/2016, 13h44
patricktoulon

re

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 ??

Citation:

Envoyé par patricktoulon

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:

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 : :plusser: & :plusser: !

01/12/2016, 18h26
patricktoulon

re

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
02/12/2016, 10h23
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 :plusser: 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.
02/12/2016, 11h25
jurassic pork

1 pièce(s) jointe(s)

hello,
en pièce jointe un fichier json plus difficile à "éplucher" :P
02/12/2016, 14h50
Marc-L

Citation:

Envoyé par mercatog

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 …

2 pièce(s) jointe(s)

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:

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 :
Pièce jointe 226542

et voici ce qu'affiche notepad++ pour le fichier :
Pièce jointe 226543

Ami calmant, J.P

recuperer valeur des item du Json VBA

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

Code:

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