You need to enable JavaScript to run this app.
优惠活动
大模型
产品
解决方案
定价
更多

将TXT中JSON数据转Excel表格及VBA 424报错解决

问题原因与解决方法

错误根源

你遇到的424错误(对象必需),核心原因是输入的JSON格式不合法:你的TXT文件里是多个独立的JSON对象,而非一个标准的JSON数组。VBA-JSON无法解析这种零散的结构,导致ParseJson返回无效对象,触发错误。

解决步骤与修正代码

关键修复点

  1. 将零散的JSON对象转换为合法的JSON数组(用[]包裹,对象间加逗号)
  2. 遍历解析后的对象集合,提取所有嵌套字段并映射到Excel列
  3. 处理可选字段(如address_line_2、region)避免报错
  4. 将数组类型的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

前置要求

  1. 启用Microsoft Scripting Runtime引用(VBA编辑器→工具→引用)
  2. 确保已导入VBA-JSON模块到工作簿中
  3. 工作簿中存在名为example的工作表

内容的提问来源于stack exchange,提问作者Suren Grigoryan

相关产品推荐
方舟 Agent Plan

超全模态模型 × Harness 升级,最新支持 Deepseek-V4.1-Flash、GLM-5.3 系列、Doubao-Seedream-5.0-pro、Kimi-K3 (部分), 限时 9.9 元起

最近更新时间:2026.08.12 08:25:21