Write partial data using VBA

Question

I have a large JSON file but the information I need is only a small part of it. Is there any way I can extract the part I want and write to an Excel sheet instead of writing the whole file? Please see the following example. I only want to extract the "text" part

{"widget": {
    "debug": "on",
    "window": {
        "title": "Sample Konfabulator Widget",
        "name": "main_window",
        "width": 500,
        "height": 500
    },
    "image": { 
        "src": "Images/Sun.png",
        "name": "sun1",
        "hOffset": 250,
        "vOffset": 250,
        "alignment": "center"
    },
    "text": {
        "data": "Click Here",
        "size": 36,
        "style": "bold",
        "name": "text1",
        "hOffset": 250,
        "vOffset": 100,
        "alignment": "center",
        "onMouseUp": "sun1.opacity = (sun1.opacity / 100) * 90;"
    }
  }
}

I don't know anything about JSON, but have you already extracted this data to Excel? Are you just trying to extract from the file into Excel? Where is the file location, where is the destination for your values, how big is the file... There are too many questions here and not enough specifics. — dwirony
– dwirony, Commented Aug 29, 2018 at 15:44

QHarr · Accepted Answer · 2018-08-29 18:45:14Z

If it is a JSON file you can read as follows and empty into sheet

Option Explicit
Public Sub GetInfo()
    Dim strJSON As String, json As Object, rowNumber As Long
    Application.ScreenUpdating = False
    Const PATH As String = "C:\Users\User\Desktop\test.JSON"
    strJSON = GetJSONFromFile(PATH)
    Set json = JsonConverter.ParseJson(strJSON)
    Set json = json("widget")("text")
    Dim key As Variant
    With ThisWorkbook.Worksheets("Sheet1")
        For Each key In json
            rowNumber = rowNumber + 1
            .Cells(rowNumber, 1) = key
            .Cells(rowNumber, 2) = json(key)
        Next key
    End With
    Application.ScreenUpdating = True
End Sub

Public Function GetJSONFromFile(ByVal PATH As String) As String
    Dim fso As Object, f As Object, outputString As String

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set f = fso.OpenTextFile(PATH)

    Do Until f.AtEndOfStream
        outputString = f.ReadAll()
    Loop
    f.Close

    GetJSONFromFile = outputString
End Function

If you inspect the JSON you can see the the top level dictionary has a key "widget" which gives access to inner dictionaries. One of these has the key "text"; that is the one you are after and can be accessed with the syntax

Set json = json("widget")("text")

You could shorten the sub code at the top to:

Option Explicit
Public Sub GetInfo()
    Dim strJSON As String, json As Object, rowNumber As Long
    Application.ScreenUpdating = False
    Const PATH As String = "C:\Users\HarrisQ\Desktop\test.JSON"
    strJSON = GetJSONFromFile(PATH)
    Set json = JsonConverter.ParseJson(strJSON)
    Set json = json("widget")("text")
    With ThisWorkbook.Worksheets("Sheet1")
        .Cells(1, 1).Resize(json.Count) = Application.WorksheetFunction.Transpose(json.keys)
        .Cells(1, 2).Resize(json.Count) = Application.WorksheetFunction.Transpose(json.Items)
    End With
    Application.ScreenUpdating = True
End Sub

Collectives™ on Stack Overflow

Write partial data using VBA

1 Answer 1

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

Comments

Your Answer

Sign up or log in

Post as a guest

Related