Write data from JSON to Excel using VBA

Viewed 83

I try to extract JSON data from an API to Excel table using VBA.
I have installed VBA-JSON and turned on Microsoft Scripting Runtime.

The json request delivers:

[
  {
    "Itemcode": "6FSTGWD40",
    "DeliveryTimeInDays": 999,
    "PalletQuantity": 12,
    "Description": "Fiberstone",
    "ItemDescription_NL": "Fiberstone",
    "ItemStatus": "E",
    "SalesPackage_NL": "Stuks   ",
    "SalesPackage_DE": "Stück",
    "SalesPackage_EN": "Unit",
    "SalesPackage_FR": "Pièce",
    "Salesprice": 132,
    "MainGroupCode": "200",
    "MainGroupDescription_NL": "Hardware",
    "MainGroupDescription_DE": "Hardware",
    "MainGroupDescription_EN": "Hardware",
    "MainGroupDescription_FR": "Hardware",
    "ProductGroupCode": "300",
    "ProductGroupDescription_NL": "Plantenbakken",
    "ProductGroupDescription_DE": "Gefässe",
    "ProductGroupDescription_EN": "Planters",
    "ProductGroupDescription_FR": "Bacs",
    "GroupDescription": "FSTC",
    "GroupDescription_NL": "Pottery Pots Fiberstone",
    "GroupDescription_DE": "Pottery Pots Fiberstone",
    "GroupDescription_EN": "Pottery Pots Fiberstone",
    "GroupDescription_FR": "Pottery Pots Fiberstone",
    "MaterialGroupCode": "500",
    "MaterialGroupDescription_NL": "Composiet",
    "MaterialGroupDescription_DE": "Verbundwerkstoff",
    "MaterialGroupDescription_EN": "Composite",
    "MaterialGroupDescription_FR": "Matériau composite",
    "ItemDescription_EN": "Fiberstone",
    "ItemDescription_DE": "Fiberstone",
    "ItemDescription_FR": "Fiberstone",
    "GTINCode": "8717775668411",
    "IsStockItem": true,
    "Warehouse": "A",
    "ItemVariety_NL": "Dice XL Glossy White",
    "ItemVariety_DE": "Dice XL Glossy White",
    "ItemVariety_EN": "Dice XL Glossy White",
    "ItemVariety_FR": "Dice XL Glossy White",
    "PotSize": null,
    "ItemPictureName": "6FSTGWD40.png",
    "ItemPictureSysmodified": "2019-03-04T11:51:24",
    "Content_Ltr": null,
    "PlantPassportCode": null,
    "Diameter": 46,
    "Length": 0,
    "Width": 0,
    "Height": 60,
    "Depth": 59,
    "Opening": 36,
    "IsOffer": false,
    "ShowOnWebsite": false,
    "Sysmodified": "2021-07-13T07:38:08.853",
    "SalesOrderSize": 1,
    "Tags": [
      {
        "Code": "Brand",
        "Values": [
          {
            "Description_NL": "Pottery Pots",
            "Description_DE": "Pottery Pots",
            "Description_EN": "Pottery Pots",
            "Description_FR": "Pottery Pots"
          }
        ]
      },
      {
        "Code": "Collection",
        "Values": [
          {
            "Description_NL": "Essential",
            "Description_DE": "Essential",
            "Description_EN": "Essential",
            "Description_FR": "Essential"
          }
        ]
      },
      {
        "Code": "ColourPlanter",
        "Values": [
          {
            "Description_NL": "Wit",
            "Description_DE": "Weiß",
            "Description_EN": "White",
            "Description_FR": "Blanche"
          }
        ]
      },
      {
        "Code": "Finish",
        "Values": [
          {
            "Description_NL": "Hoogglans",
            "Description_DE": "Hochglanz",
            "Description_EN": "High gloss",
            "Description_FR": "Brillant"
          }
        ]
      },
      {
        "Code": "Location",
        "Values": [
          {
            "Description_NL": "Buiten",
            "Description_DE": "Draußen",
            "Description_EN": "Outdoor",
            "Description_FR": "Extérieur"
          },
          {
            "Description_NL": "Binnen",
            "Description_DE": "Innen",
            "Description_EN": "Indoor",
            "Description_FR": "Intérieur"
          }
        ]
      },
      {
        "Code": "Material",
        "Values": [
          {
            "Description_NL": "Fiberstone",
            "Description_DE": "Fiberstone",
            "Description_EN": "Fiberstone",
            "Description_FR": "Fiberstone"
          }
        ]
      },
      {
        "Code": "MaterialProperties",
        "Values": [
          {
            "Description_NL": "Handgemaakt",
            "Description_DE": "Handgefertigt",
            "Description_EN": "Handmade",
            "Description_FR": "Fait à la main"
          }
        ]
      },
      {
        "Code": "Serie",
        "Values": [
          {
            "Description_NL": "Fiberstone",
            "Description_DE": "Fiberstone",
            "Description_EN": "Fiberstone",
            "Description_FR": "Fiberstone"
          }
        ]
      },
      {
        "Code": "Shape",
        "Values": [
          {
            "Description_NL": "Cylinder",
            "Description_DE": "Cylinder",
            "Description_EN": "Cylinder",
            "Description_FR": "Cylinder"
          }
        ]
      },
      {
        "Code": "Structure",
        "Values": [
          {
            "Description_NL": "Egaal",
            "Description_DE": "Glatt",
            "Description_EN": "Smooth",
            "Description_FR": "Lisse"
          }
        ]
      }
    ]
  },
{
    "Itemcode": "8EE425140",
    "DeliveryTimeInDays": 2,
    "PalletQuantity": 288,
    "Description": "Begonia maculata",
    "ItemDescription_NL": "Begonia maculata",
    "ItemStatus": "A",
    "SalesPackage_NL": "Stuks   ",
    "SalesPackage_DE": "Stück",
    "SalesPackage_EN": "Unit",
    "SalesPackage_FR": "Pièce",
    "Salesprice": 8.45,
    "MainGroupCode": "200",
    "MainGroupDescription_NL": "Hardware",
    "MainGroupDescription_DE": "Hardware",
    "MainGroupDescription_EN": "Hardware",
    "MainGroupDescription_FR": "Hardware",
    "ProductGroupCode": "600",
    "ProductGroupDescription_NL": "Artificial ",
    "ProductGroupDescription_DE": "Artificial ",
    "ProductGroupDescription_EN": "Artificial ",
    "ProductGroupDescription_FR": "Artificielle",
    "GroupDescription": "KUC",
    "GroupDescription_NL": "Artificial decoration",
    "GroupDescription_DE": "Artificial Dekoration",
    "GroupDescription_EN": "Artificial decoration",
    "GroupDescription_FR": "Décoration artificielles",
    "MaterialGroupCode": null,
    "MaterialGroupDescription_NL": null,
    "MaterialGroupDescription_DE": null,
    "MaterialGroupDescription_EN": null,
    "MaterialGroupDescription_FR": null,
    "ItemDescription_EN": "Begonia maculata",
    "ItemDescription_DE": "Begonia maculata",
    "ItemDescription_FR": "Begonia maculata",
    "GTINCode": "8714344320619",
    "IsStockItem": true,
    "Warehouse": "A",
    "ItemVariety_NL": "Tak",
    "ItemVariety_DE": "Zweig",
    "ItemVariety_EN": "Branch",
    "ItemVariety_FR": "Branche",
    "PotSize": "0",
    "ItemPictureName": "8EE425140.png",
    "ItemPictureSysmodified": "2020-02-11T08:57:17",
    "Content_Ltr": null,
    "PlantPassportCode": null,
    "Diameter": 0,
    "Length": 0,
    "Width": 0,
    "Height": 120,
    "Depth": 0,
    "Opening": 0,
    "IsOffer": false,
    "ShowOnWebsite": true,
    "Sysmodified": "2021-07-06T07:38:14.623",
    "SalesOrderSize": 1,
    "Tags": [
      {
        "Code": "ArtificialGroup",
        "Values": [
          {
            "Description_NL": "Overig",
            "Description_DE": "Andere",
            "Description_EN": "Other",
            "Description_FR": "Autres"
          }
        ]
      },
      {
        "Code": "ArtificialType",
        "Values": [
          {
            "Description_NL": "Tak",
            "Description_DE": "Ast",
            "Description_EN": "Branch",
            "Description_FR": "Branche"
          }
        ]
      },
      {
        "Code": "ArtificialVariety",
        "Values": [
          {
            "Description_NL": "Planten",
            "Description_DE": "Pflanzen",
            "Description_EN": "plants-artificial",
            "Description_FR": "Plantes"
          }
        ]
      }
    ]
  }
]

With the following code I can write the items Itemcode, DeliveryTimeInDays, PalletQuantity and so on in specific Excel cells.

I don't get it to work to write the "Tags" with "Code" and "Values" in Excel cells.

Sub test_json()
' dieses makro ist der startpunkt: einholen von aid, ean etc. dieses makro ruft eine liste aller artikel mit status ab.
Worksheets("test").Range("a1:zz100000").ClearContents
Dim ws As Worksheet, jsonObject As Object, jsonText As String, i As Long, http As Object
    i = 3
    'requesturl = "https://customerapi_dev.nieuwkoop-europe.com/items?sysmodified=2000-01-01"
     requesturl = "https://customerapi_dev.nieuwkoop-europe.com/items?sysmodified=2021-02-11&itemCode=6PPNLBO80"
        Set http = CreateObject("MSXML2.XMLHTTP")
        http.Open "GET", requesturl, False
        http.send
        
        Set jsonObject = JsonConverter.ParseJson(http.responseText)

Worksheets("test").Cells(1, 1).Value = "Itemcode"
Worksheets("test").Cells(1, 2).Value = "DeliveryTimeInDays"
Worksheets("test").Cells(1, 3).Value = "PalletQuantity"

For Each Item In jsonObject
Worksheets("test").Cells(i, 1).Value = Item("Itemcode")
Worksheets("test").Cells(i, 2).Value = Item("DeliveryTimeInDays")
Worksheets("test").Cells(i, 3).Value = Item("PalletQuantity")

i = i + 1
Next Item
    
End Sub

I tried as loop code like the following but I always get an error.

For Each Item In jsonObject ("Tags")("Code")("Values")
Worksheets("test").Cells(i, 5).Value = Item("Description_NL")
Worksheets("test").Cells(i, 6).Value = Item("Description_DE")
Worksheets("test").Cells(i, 7).Value = Item("Description_FR")

i = i + 1
Next Item

How can I write the "Tags" data (for instance "Code" and values like Description_NL) from JSON file in the Excel cells too?

2 Answers

Values is an array (parsed into a collection) so you want tag("Values")(n)

 Dim item, tag, n as Long
    For Each item In jsonObject
        For Each tag In item("Tags")
            For n = 1 to tag("Values").Count
                Debug.Print tag("Values")(n)("Description_NL")
            Next
        Next
    Next item

Alternatively iterate the objects

    Dim item, tag, val
    For Each item In jsonObject
        For Each tag In item("Tags")
            For Each val In tag("Values")
                Debug.Print item("Itemcode"), tag("Code"), val("Description_NL")
            Next
        Next
    Next item

Following the first comment from CDP1802, I coded another for each loop and it works fine:

Sub getactivearticleswithstatus()

Dim ws As Worksheet, jsonObject As Object, jsonText As String, i As Long, http As Object
Dim item, tag, eigenschaft
Dim j, m


i = 3
   requesturl="..."
        Set http = CreateObject("MSXML2.XMLHTTP")
        http.Open "GET", requesturl, False
        http.send
        
        Set jsonObject = JsonConverter.ParseJson(http.responseText)


For Each item In jsonObject
        Worksheets("daten-api").Cells(i, 1).value = item("Itemcode")
        Worksheets("daten-api").Cells(i, 2).value = item("DeliveryTimeInDays")
        Worksheets("daten-api").Cells(i, 3).value = item("PalletQuantity")
        Worksheets("daten-api").Cells(i, 4).value = item("Description")
        Worksheets("daten-api").Cells(i, 5).value = item("ItemDescription_NL")
        Worksheets("daten-api").Cells(i, 6).value = item("ItemStatus")
        Worksheets("daten-api").Cells(i, 7).value = item("SalesPackage_NL")
        Worksheets("daten-api").Cells(i, 8).value = item("SalesPackage_DE")
        Worksheets("daten-api").Cells(i, 9).value = item("SalesPackage_EN")
        Worksheets("daten-api").Cells(i, 10).value = item("SalesPackage_FR")
        Worksheets("daten-api").Cells(i, 11).value = item("Salesprice")
        Worksheets("daten-api").Cells(i, 12).value = item("MainGroupCode")
        Worksheets("daten-api").Cells(i, 13).value = item("MainGroupDescription_NL")
        Worksheets("daten-api").Cells(i, 14).value = item("MainGroupDescription_DE")
        Worksheets("daten-api").Cells(i, 15).value = item("MainGroupDescription_EN")
        Worksheets("daten-api").Cells(i, 16).value = item("MainGroupDescription_FR")
        Worksheets("daten-api").Cells(i, 17).value = item("ProductGroupCode")
        Worksheets("daten-api").Cells(i, 18).value = item("ProductGroupDescription_NL")
        Worksheets("daten-api").Cells(i, 19).value = item("ProductGroupDescription_DE")
        Worksheets("daten-api").Cells(i, 20).value = item("ProductGroupDescription_EN")
        Worksheets("daten-api").Cells(i, 21).value = item("ProductGroupDescription_FR")
        Worksheets("daten-api").Cells(i, 22).value = item("GroupDescription")
        Worksheets("daten-api").Cells(i, 23).value = item("GroupDescription_NL")
        Worksheets("daten-api").Cells(i, 24).value = item("GroupDescription_DE")
        Worksheets("daten-api").Cells(i, 25).value = item("GroupDescription_EN")
        Worksheets("daten-api").Cells(i, 26).value = item("GroupDescription_FR")
        Worksheets("daten-api").Cells(i, 27).value = item("MaterialGroupCode")
        Worksheets("daten-api").Cells(i, 28).value = item("MaterialGroupDescription_NL")
        Worksheets("daten-api").Cells(i, 29).value = item("MaterialGroupDescription_DE")
        Worksheets("daten-api").Cells(i, 30).value = item("MaterialGroupDescription_EN")
        Worksheets("daten-api").Cells(i, 31).value = item("MaterialGroupDescription_FR")
        Worksheets("daten-api").Cells(i, 32).value = item("ItemDescription_EN")
        Worksheets("daten-api").Cells(i, 33).value = item("ItemDescription_DE")
        Worksheets("daten-api").Cells(i, 34).value = item("ItemDescription_FR")
        Worksheets("daten-api").Cells(i, 35).value = item("GTINCode")
        Worksheets("daten-api").Cells(i, 36).value = item("IsStockItem")
        Worksheets("daten-api").Cells(i, 37).value = item("Warehouse")
        Worksheets("daten-api").Cells(i, 38).value = item("ItemVariety_NL")
        Worksheets("daten-api").Cells(i, 39).value = item("ItemVariety_DE")
        Worksheets("daten-api").Cells(i, 40).value = item("ItemVariety_EN")
        Worksheets("daten-api").Cells(i, 41).value = item("ItemVariety_FR")
        Worksheets("daten-api").Cells(i, 42).value = item("PotSize")
        Worksheets("daten-api").Cells(i, 43).value = item("ItemPictureName")
        Worksheets("daten-api").Cells(i, 44).value = item("ItemPictureSysmodified")
        Worksheets("daten-api").Cells(i, 45).value = item("Content_Ltr")
        Worksheets("daten-api").Cells(i, 46).value = item("PlantPassportCode")
        Worksheets("daten-api").Cells(i, 47).value = item("Diameter")
        Worksheets("daten-api").Cells(i, 48).value = item("Length")
        Worksheets("daten-api").Cells(i, 49).value = item("Width")
        Worksheets("daten-api").Cells(i, 50).value = item("Height")
        Worksheets("daten-api").Cells(i, 51).value = item("Depth")
        Worksheets("daten-api").Cells(i, 52).value = item("Opening")
        Worksheets("daten-api").Cells(i, 53).value = item("IsOffer")
        Worksheets("daten-api").Cells(i, 54).value = item("ShowOnWebsite")
        Worksheets("daten-api").Cells(i, 55).value = item("Sysmodified")
        Worksheets("daten-api").Cells(i, 56).value = item("SalesOrderSize")
        
        
        
        k = 0
        
        For Each tag In item("Tags")
        
            For Each eigenschaft In tag("Values")
            
            Worksheets("daten-api").Cells(i, 60 + k).value = tag("Code")
                Worksheets("daten-api").Cells(i, 61 + k).value = eigenschaft("Description_DE")
                Worksheets("daten-api").Cells(i, 62 + k).value = eigenschaft("Description_NL")
                Worksheets("daten-api").Cells(i, 63 + k).value = eigenschaft("Description_EN")
                Worksheets("daten-api").Cells(i, 64 + k).value = eigenschaft("Description_FR")
                'Worksheets("daten-api").Cells(i, 61 + k).value = tag("Values")(1)("Description_DE")
                k = k + 5
                
            Next
        
        Next tag
           
        i = i + 1
Next item
  
End Sub

Related