我有一个大的JSON文件,但我需要的信息只是其中的一小部分。有没有什么办法可以提取我想和写入到一个Excel工作表,而不是写整个文件的一部分?请看下面的例子。我只是想提取“文本”部分
{"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;"
}
}
}
如果它是一个JSON文件,您可以如下所示,清空成片。
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
如果检查JSON可以看到顶级的字典里的一个关键"widget"
它可以访问内部字典。其中一个有钥匙"text"
;这是一个你后,可与语法来访问
Set json = json("widget")("text")
你可以在顶部缩短子代码:
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