Estrazione dati da Array contenuti in stringa Json

Question

Ciao Ho una stringa JSON con dentro un array ma non riesco a recuperare i dati al suo interno. Ho effettuato diverse prove ma senza esito, ho sempre come risposta l'errore di runtime 424 oggetto richiesto.Sotto ho aggiunto il codice della sub, spero che qualcuno mi possa dare qualche suggerimentoGrazie

Public Sub GetPerson7(IDPerson As Long)

Dim db As Database, qdef As QueryDef

Dim FileNum As Integer

Dim DataLine As String, jsonStr As String, strSQL As String

Dim p As Object, element As Variant

Dim p2 As Object, element2 As Variant

Set db = CurrentDb

myNestedArraysJson = "{""transfers"":{""570988"":{""wyId"":""570988"",""transfer"":[{""fromTeamId"":333,""fromTeamName"":""Boston"",""toTeamId"":17517,""toTeamName"":""Ebusua Dwarfs"",""active"":0,""startDate"":""2018-03-01"",""endDate"":""0000-00-00"",""type"":""Free Transfer"",""value"":0,""currency"":""EUR"",""announceDate"":""""}]}}}"

Set p = ParseJson(myNestedArraysJson)

'If Mid(z, 3, 4) <> "code" Then

For Each element In p.Items

strSQL = "PARAMETERS [wyId] Long, [fromteam] Long,[namefrom] Text(255),[teamid]  Long,[nameto] Text(255),[startdate] Text(255),[enddate] Text(255); " _

       & "INSERT INTO change (wyid,fromteam,namefrom,teamid,nameto, startdate,enddate)" _

& "VALUES([wyid], [fromteam], [namefrom],[teamid],[nameto],[startdate],[enddate]);"

Set qdef = db.CreateQueryDef("", strSQL)

Dim transfers As Object

Set transfers = p("transfers")

Dim change As Variant

For Each change In transfers.Items

qdef!wyid = change("wyId")

qdef!fromteam = change("fromteamid")

qdef!namefrom = change("fromteamname")

qdef!teamid = change("toteamid")

qdef!nameto = change("toteamname")

qdef!startdate = change("startdate")

qdef!enddate = change("enddate")

'transfer = change("transfer")("fromteamid")

   qdef.Execute 

Next

Exit For

Next element

Set element = Nothing

Set p = Nothing

End Sub

Answer 1

Ciao Claudio,

ho fatto qualche piccola modifica al tuo codice. Utilizzando la funzione che segue riesco ad inserire un record nella tabella "change"

---

Public Sub GetPerson7()

    Dim db As DAO.Database

    Dim qdef As DAO.QueryDef

    Dim strSQL As String

    Dim myNestedArraysJson As Variant

    Dim p As Object

    Dim transfers As Object

    Dim transfers2 As Object

    Dim element As Variant

    Dim change As Variant

    Dim change2 As Variant

    Set db = CurrentDb

    strSQL = "PARAMETERS [wyId] Long, [fromteam] Long,[namefrom] Text(255),[teamid]  Long," _

                    & "[nameto] Text(255),[startdate] Text(255),[enddate] Text(255); " _

                    & "INSERT INTO change (wyid,fromteam,namefrom,teamid,nameto, startdate,enddate)" _

                    & "VALUES([wyid], [fromteam], [namefrom],[teamid],[nameto],[startdate],[enddate]);"

    Set qdef = db.CreateQueryDef("", strSQL)

    myNestedArraysJson = "{""transfers"":{""570988"":{""wyId"":""570988""," _

                & """transfer"":[{""fromTeamId"":333,""fromTeamName"":""Boston""," _

                & """toTeamId"":17517,""toTeamName"":""Ebusua Dwarfs"",""active"":0," _

                & """startDate"":""2018-03-01"",""endDate"":""0000-00-00""," _

                & """type"":""Free Transfer"",""value"":0," _

                & """currency"":""EUR"",""announceDate"":""""}]}}}"

    Set p = ParseJson(myNestedArraysJson)

    For Each element In p.Items

        Set transfers = p("transfers")

        For Each change In transfers.Items

            qdef!wyid = change("wyId")

            Set transfers2 = change("transfer")

            For Each change2 In transfers2

                qdef!fromteam = change2("fromTeamId")

                qdef!namefrom = change2("fromTeamName")

                qdef!teamid = change2("toTeamId")

                qdef!nameto = change2("toTeamName")

                qdef!startDate = change2("startDate")

                qdef!enddate = change2("endDate")

                qdef.Execute

            Next

        Next

    Next element

    Set element = Nothing

    Set p = Nothing

    Set transfers = Nothing

    Set transfers2 = Nothing

End Sub

---

David

Answer 2

Ciao Claudio,

ho modificato il codice precedente e implementato la nuova estrazione. Al seguente link Parse from json trovi una demo in cui ho racchiuso la vecchia e la nuova soluzione.

Lanciando la funzione GetPerson7_NEW verranno importati i record nella tabella tCompetition.

Potrebbe non essere il modo più efficiente, ma al momento non ho tempo per testare altre soluzioni.

Fammi sapere.

David

Answer 3

Ciao Claudio,

ricordati di indicare la risposta che ha risolto il tuo problema indicandola come risposta.

Aiuterai altri utenti con lo stesso problema a rintracciare più velocemente la soluzione.

David

Answer 4

Ciao David,

scusa se ti disturbo ancora, ho una situazione simile a quella della volta scorsa, dove con il tuo prezioso aiuto risolvesti il problema di estrazione dati da array annidati.

Nel codice sottostante ho una stringa json con un annidamento ancora più complicato rispetto al precedente, mi potresti per cortesia dare qualche suggerimento per la risoluzione.

Grazie

Buona serata

Claudio 

Public Sub GetPerson7(IDPerson As Long)

    Dim db As DAO.Database

    Dim qdef As DAO.QueryDef

    'Dim db As Database

    'Dim qdef As QueryDef

    Dim strSQL As String

    Dim myNestedArraysJson As Variant

    Dim p As Object

    Dim competitionId As Object

    Dim competitionId2 As Object

    Dim element As Variant

    Dim change As Variant

    Dim change2 As Variant

Dim FileNum As Integer

Dim DataLine As String, jsonStr As String

Dim p2 As Object

Set db = CurrentDb

    'Set p = ParseJson(y)

   strSQL = "PARAMETERS [matchId] Long,[competitionId] Long,[partita] Text(255),[data] Text(255),[seasonId] Long,[gameweek] Long ; " _

                  & "INSERT INTO Calendario (matchid,competitionid,partita,data,seasonid,gameweek)" _

                  & "VALUES([matchid],[competitionid],[partita],[data],[seasonid],[gameweek]);"

   Set qdef = db.CreateQueryDef("", strSQL)

myNestedArraysJson = "{""competitionId"":524,""seasonId"":185382,""matches"":[{""matchId"":2759811,""goals"":[],""match"":{""wyId"":2759811,""gsmId"":-89032," _

    & """label"":""Frosinone - Chievo, 0 - 0"",""date"":""May 26, 2019 at 5:00:00 PM GMT+2"",""dateutc"":""2019-05-26 15:00:00"",""status"":""Fixture""," _

    & """duration"":""Regular"",""winner"":0,""competitionId"":524,""seasonId"":185382,""roundId"":4416686,""gameweek"":38,""teamsData"":{""3254"":{""teamId"":3254,""side"":""home""," _

    & """score"":0,""scoreHT"":0,""scoreET"":0,""scoreP"":0,""coachId"":0,""hasFormation"":0,""formation"":null},""3165"":{""teamId"":3165,""side"":""away""," _

    & """score"":0,""scoreHT"":0,""scoreET"":0,""scoreP"":0,""coachId"":0,""hasFormation"":0,""formation"":null}},""venue"":null,""referees"":[]}},{""matchId"":2759812,""goals"":[],""match"":{""wyId"":2759812,""gsmId"":-89033,""label"":""Internazionale - Empoli, 0 - 0""," _

    & """date"":""May 26, 2019 at 5:00:00 PM GMT+2"",""dateutc"":""2019-05-26 15:00:00"",""status"":""Fixture"",""duration"":""Regular""," _

    & """winner"":0,""competitionId"":524,""seasonId"":185382,""roundId"":4416686,""gameweek"":38,""teamsData"":{""3161"":{""teamId"":3161,""side"":""home"",""score"":0,""scoreHT"":0,""scoreET"":0,""scoreP"":0,""coachId"":0,""hasFormation"":0,""formation"":null},""3178"":{""teamId"":3178,""side"":""away""," _

    & """score"":0,""scoreHT"":0,""scoreET"":0,""scoreP"":0,""coachId"":0,""hasFormation"":0,""formation"":null}},""venue"":null,""referees"":[]}}]}"

  '''Set p = ParseJson(y)

  Set p = ParseJson(myNestedArraysJson)

  For Each element In p.Items

      Set competitionId = p("CompetitionID")

       For Each change In competitionId.Items

            qdef!matchid = change("matchid")

            Set competitionId2 = change("match")

            For Each change2 In competitionId2

                qdef!partita = change2("label")

                qdef!Data = change2("date")

                qdef!competitionId = change2("competitionid")

                qdef!seasonId = change2("seasonid")

                qdef!gameweek = change2("gameweek")

                qdef.Execute

            Next

        Next

    Next element

    Set element = Nothing

    Set p = Nothing

    Set competitionId = Nothing

    Set competitionId2 = Nothing

End Sub

Answer 5

Ciao David,

ho provato le tue modifiche funziona alla grande

Grazie mille per l'aiuto

Claudio