from json to csv

[sal21]

Found this code:

Code: Select all

Option Explicit
' PGC 2016 Parse a JSON and write it in a table format
' records like { field1, field 2, ... fieldN}, each field with name and value separated by ":"
' Ex: [{"F1": "Yes", "F2": 123}, {"F1": "No", "F3": "True", "F2" : 123}]

Sub TestJSON()
Dim sPathname As String, sText As String
Dim iFile As Integer
Dim vRecords As Variant
Dim dicFields As Object

sPathname = "c:\tabulati\COMUNI_ALESSIO.txt"

' read the file into a string
iFile = FreeFile
Open sPathname For Input As #iFile
sText = Input$(LOF(iFile), #iFile)
Close #iFile
sText = Replace(Replace(sText, vbCr, ""), vbLf, "")

' get a dictionary object to hold the fields names and indices
Set dicFields = CreateObject("Scripting.Dictionary")

' load all the information in a table format into an array
JSONArray sText, vRecords, dicFields

' write the information in the active worksheet
Range("A1").Resize(1, dicFields.Count).Value = dicFields.Keys
Range("A2").Resize(UBound(vRecords, 1), UBound(vRecords, 2)).Value = vRecords
Columns(1).Resize(, dicFields.Count).AutoFit

End Sub
Sub JSONArray(sText As String, vRecords As Variant, dicFields As Object)

Dim lRecord As Long, lField As Long
Dim regex As Object, regexRMatches As Object, regexFmatches As Object

Set regex = CreateObject("VBScript.RegExp")
regex.Pattern = "\{([^}]+)\}" ' to match a record
regex.Global = True
Set regexRMatches = regex.Execute(sText) ' gets all the records
ReDim vRecords(1 To regexRMatches.Count, 1 To 1)  ' initialize the array

regex.Pattern = """([^""]+)""\s*:\s*(""([^""]+)""|\d+(\.\d+)?)" ' to match a field

For lRecord = 1 To regexRMatches.Count
    Set regexFmatches = regex.Execute(regexRMatches(lRecord - 1)) ' gets the fields in the current record
    
    For lField = 1 To regexFmatches.Count
        With regexFmatches(lField - 1)
            If Not dicFields.Exists(.submatches(0)) Then ' if first time field appears add it to the dictionary
                dicFields.Add .submatches(0), dicFields.Count + 1
                ReDim Preserve vRecords(1 To UBound(vRecords, 1), 1 To dicFields.Count)
            End If
            vRecords(lRecord, dicFields(.submatches(0))) = .submatches(1)
        End With
    Next lField
Next lRecord

End Sub

instead to put value of arry in cell of sheet, i need to play with the array vRecords
Possible?

[HansV]

Why not? You can loop through the array elements:

Code: Select all

    Dim i As Long
    Dim j As Long
    For i = LBound(vRecords, 1) To UBound(vRecords, 1)
        For j = LBound(vRecorsds, 2) To UBound(vRecords, 2)
            Debug.Print i, j, vRecords(i, j)
        Next j
    Next i

[sal21]

Why not? You can loop through the array elements:

Code: Select all

    Dim i As Long
    Dim j As Long
    For i = LBound(vRecords, 1) To UBound(vRecords, 1)
        For j = LBound(vRecorsds, 2) To UBound(vRecords, 2)
            Debug.Print i, j, vRecords(i, j)
        Next j
    Next i

GREAT!
But the for next print all line in vertical i need in orizontal
I need exactlly the result in the sheet in image
In other case the first two column A and B not are important, and the first row that contain title not are important

[HansV]

Experiment with this:

Code: Select all

    Dim i As Long
    Dim j As Long
    For i = LBound(vRecords, 2) + 2 To UBound(vRecords, 2)
        For j = LBound(vRecords, 1) + 1 To UBound(vRecords, 1)
            Debug.Print i, j, vRecords(i, j)
        Next j
    Next i