json - 使用 VBA 将数据从 JSON 写入 Excel

Question

我尝试使用 VBA 将 JSON 数据从 API 提取到 Excel 表。
我已经安装了 VBA-JSON 并打开了 Microsoft Scripting Runtime。

json 请求传递:

[
  {
    "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"
          }
        ]
      }
    ]
  }
]

使用以下代码，我可以在特定的 Excel 单元格中写入项目 Itemcode、DeliveryTimeInDays、PalletQuantity 等。

我无法在 Excel 单元格中使用“代码”和“值”编写“标签”。

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

我试过像下面这样的循环代码，但我总是得到一个错误。

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

我怎样才能从 JSON 文件中写入“标签”数据(例如“代码”和 Description_NL 之类的值)到 Excel 单元格中？

Answer 1

Values 是一个数组(解析成一个集合)所以你想要 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

或者迭代对象

    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