将TXT中JSON数据转Excel表格及VBA 424报错解决
问题原因与解决方法
错误根源
你遇到的424错误(对象必需),核心原因是输入的JSON格式不合法:你的TXT文件里是多个独立的JSON对象,而非一个标准的JSON数组。VBA-JSON无法解析这种零散的结构,导致ParseJson返回无效对象,触发错误。
解决步骤与修正代码
关键修复点
- 将零散的JSON对象转换为合法的JSON数组(用
[]包裹,对象间加逗号) - 遍历解析后的对象集合,提取所有嵌套字段并映射到Excel列
- 处理可选字段(如
address_line_2、region)避免报错 - 将数组类型的
natures_of_control转为逗号分隔的字符串
完整修正代码
Sub ConvertPSCJsonToExcel() Dim FSO As New FileSystemObject Dim JsonTS As TextStream Dim JsonText As String Dim Parsed As Collection Dim pscItem As Dictionary Dim ws As Worksheet Dim headers() As String Dim rowNum As Long Dim colNum As Integer ' 读取TXT文件内容 Set JsonTS = FSO.OpenTextFile("psc-snapshot-2022-11-12_1of22.txt", ForReading) JsonText = JsonTS.ReadAll JsonTS.Close ' 修复JSON格式:转为合法数组 JsonText = "[" & Replace(JsonText, vbCrLf, ",") & "]" JsonText = Replace(JsonText, " {", "{") ' 移除对象前的空白 ' 解析JSON为对象集合 Set Parsed = JsonConverter.ParseJson(JsonText) ' 目标工作表设置 Set ws = ThisWorkbook.Sheets("example") ws.Cells.Clear ' 清空原有数据 ' 定义表头 headers = Split("Company Number,Address Line 1,Address Line 2,Premises,Locality,Region,Postal Code,Country,Ceased On,Country of Residence,Birth Month,Birth Year,ETag,Kind,Self Link,Full Name,Title,Forename,Middle Name,Surname,Nationality,Natures of Control,Notified On", ",") ' 写入表头 For colNum = LBound(headers) To UBound(headers) ws.Cells(1, colNum + 1).Value = headers(colNum) Next colNum rowNum = 2 ' 数据从第2行开始写入 ' 遍历每个PSC条目 For Each pscItem In Parsed ' 公司编号 ws.Cells(rowNum, 1).Value = pscItem("company_number") ' 地址字段(嵌套结构) With pscItem("data")("address") ws.Cells(rowNum, 2).Value = .Item("address_line_1") ws.Cells(rowNum, 3).Value = IIf(.Exists("address_line_2"), .Item("address_line_2"), "") ws.Cells(rowNum, 4).Value = .Item("premises") ws.Cells(rowNum, 5).Value = .Item("locality") ws.Cells(rowNum, 6).Value = IIf(.Exists("region"), .Item("region"), "") ws.Cells(rowNum, 7).Value = .Item("postal_code") ws.Cells(rowNum, 8).Value = .Item("country") End With ' 核心数据字段 With pscItem("data") ws.Cells(rowNum, 9).Value = .Item("ceased_on") ws.Cells(rowNum, 10).Value = .Item("country_of_residence") ' 出生日期(嵌套结构) ws.Cells(rowNum, 11).Value = .Item("date_of_birth")("month") ws.Cells(rowNum, 12).Value = .Item("date_of_birth")("year") ws.Cells(rowNum, 13).Value = .Item("etag") ws.Cells(rowNum, 14).Value = .Item("kind") ' 链接字段 ws.Cells(rowNum, 15).Value = .Item("links")("self") ' 姓名相关字段 ws.Cells(rowNum, 16).Value = .Item("name") With .Item("name_elements") ws.Cells(rowNum, 17).Value = .Item("title") ws.Cells(rowNum, 18).Value = .Item("forename") ws.Cells(rowNum, 19).Value = IIf(.Exists("middle_name"), .Item("middle_name"), "") ws.Cells(rowNum, 20).Value = .Item("surname") End With ws.Cells(rowNum, 21).Value = .Item("nationality") ' 控制权类型(数组转字符串) Dim controlNature As Variant Dim controlStr As String controlStr = "" For Each controlNature In .Item("natures_of_control") controlStr = controlStr & controlNature & ", " Next controlNature ws.Cells(rowNum, 22).Value = Left(controlStr, Len(controlStr) - 2) ' 移除末尾逗号 ws.Cells(rowNum, 23).Value = .Item("notified_on") End With rowNum = rowNum + 1 Next pscItem ' 自动调整列宽 ws.Columns.AutoFit MsgBox "数据转换完成!", vbInformation End Sub
前置要求
- 启用Microsoft Scripting Runtime引用(VBA编辑器→工具→引用)
- 确保已导入VBA-JSON模块到工作簿中
- 工作簿中存在名为
example的工作表
内容的提问来源于stack exchange,提问作者Suren Grigoryan
相关产品推荐
相关产品推荐

