If you *do have* the original JSON file (or string saved in a plain
text file), the following will work if the JSON structure is 'List'
format...
Option Explicit
Sub Parse_JsonList()
Dim vData, v1, v2, vTextOut
Dim sFile$, sMsg$
Dim n&, k&, i&, lMaxCols&, lNum&
Dim bValuesOnly As Boolean
sFile = Application.GetOpenFilename(Title:="Select JSON to parse")
If sFile = "False" Then Exit Sub '//user cancels
sMsg = "Do you want to parse 'values' only, as opposed to
'name:value' pairs?"
bValuesOnly = (MsgBox(sMsg, vbYesNo) = vbYes)
'Get the JSON string from the file,
'filter out unwanted characters,
'and dump the list into an array.
vData = Split(FilterString(ReadTextFile(sFile), "},:"), "},")
'Get the number of cols needed
For n = LBound(vData) To UBound(vData)
lNum = UBound(Split(vData(0), ",")) + 1
lMaxCols = IIf(lNum > lMaxCols, lNum, lMaxCols)
Next 'n
ReDim vTextOut(1 To UBound(vData) + 1, 1 To lMaxCols)
For n = LBound(vData) To UBound(vData)
v1 = Split(vData(n), ",")
For k = LBound(v1) To UBound(v1)
If bValuesOnly Then
vTextOut(n + 1, k + 1) = Split(v1(k), ":")(1)
Else
vTextOut(n + 1, k + 1) = v1(k)
End If 'bValsOnly
Next 'k
'Rebuild vData for output to parsed file
vData(n) = Join(Application.Index(vTextOut, n + 1, 0), ",")
Next 'n
'Optionally, store the data in a normal csv file
'(User may simply cancel dialog to skip this step)
sFile = Application.GetSaveAsFilename(Title:="Choose the output
file")
If Not sFile = "False" Then WriteTextFile Join(vData, vbLf), sFile
'Dump the data into the worksheet
Cells(1, 1).Resize(UBound(vTextOut), UBound(vTextOut, 2)) = vTextOut
ActiveSheet.UsedRange.EntireColumn.AutoFit
End Sub 'Parse_JsonList
Function ReadTextFile$(Filename$)
' Reads large amounts of data from a text file in one single step.
Dim iNum%
On Error GoTo ErrHandler
iNum = FreeFile(): Open Filename For Input As #iNum
ReadTextFile = Space$(LOF(iNum))
ReadTextFile = Input(LOF(iNum), iNum)
ErrHandler:
Close #iNum: If Err Then Err.Raise Err.Number, , Err.Description
End Function 'ReadTextFile()
Sub WriteTextFile(TextOut$, Filename$, _
Optional AppendMode As Boolean = False)
' Reusable procedure that Writes/Overwrites or Appends
' large amounts of data to a Text file in one single step.
' **Does not create a blank line at the end of the file**
Dim iNum%
On Error GoTo ErrHandler
iNum = FreeFile()
If AppendMode Then
Open Filename For Append As #iNum: Print #iNum, vbCrLf & TextOut;
Else
Open Filename For Output As #iNum: Print #iNum, TextOut;
End If
ErrHandler:
Close #iNum: If Err Then Err.Raise Err.Number, , Err.Description
End Sub 'WriteTextFile()
Function FilterString$(ByVal TextIn$, Optional IncludeChars$, _
Optional IncludeLetters As Boolean = True, _
Optional IncludeNumbers As Boolean = True)
' Filters out all unwanted characters in a string.
' Arguments: TextIn The string being filtered.
' IncludeChars [Optional] Any non alpha-numeric
characters to keep.
' IncludeLetters [Optional] Keeps any letters.
' IncludeNumbers [Optional] Keeps any numbers.
'
' Returns: String containing only wanted characters.
' Comments: Works very fast using the Mid$() function over other
methods.
Const sSource As String = "FilterString()"
'The basic characters to always keep by default
Const sLetters As String = "abcdefghijklmnopqrstuvwxyz"
Const sNumbers As String = "0123456789"
Dim i&, CharsToKeep$
CharsToKeep = IncludeChars
If IncludeLetters Then _
CharsToKeep = CharsToKeep & sLetters & UCase(sLetters)
If IncludeNumbers Then CharsToKeep = CharsToKeep & sNumbers
For i = 1 To Len(TextIn)
If InStr(CharsToKeep, Mid$(TextIn, i, 1)) Then _
FilterString = FilterString & Mid$(TextIn, i, 1)
Next
End Function 'FilterString()
--
Garry
Free usenet access at
http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
("
)"