VBA解析JSON遇类型不兼容问题，如何从JsonObject获取项值？

错误原因分析 #

你的JSON结构中，Header是单个对象（使用{}包裹），而非数组（[]包裹）。当你用For Each Item In jsonFile("CRM").Item("Header")遍历的时候，实际上是在遍历Header对象的所有键名（比如"ID"、"GSID"这类字符串），此时Item是字符串类型，调用Item("GSID")自然会触发"类型不兼容"错误。

修正后的读取代码 #

直接访问Header对象的属性即可，不需要循环：

Dim strFooter As String, strHeader As String
Dim fso As FileSystemObject
Dim strFileContent As String
Dim strFile As String, strFilePath As String, strFilePathInput As String
Dim srtVat As String, strCompanyID As String, strCompanyName As String
Dim xmlFile As Object
Dim jsonFileInput As TextStream
Dim jsonFile As Object ' 声明为Object类型

Set fso = New FileSystemObject ' 初始化文件系统对象
Set jsonFileInput = fso.OpenTextFile(strFilePathInput & strFile, ForReading)
strFileContent = jsonFileInput.ReadAll
jsonFileInput.Close ' 读取完成后关闭文件流

Set jsonFile = JsonConverter.ParseJson(strFileContent)

' 直接读取Header中的属性
Debug.Print jsonFile("CRM")("Header")("GSID")
Debug.Print jsonFile("CRM")("Header")("ID")
Debug.Print jsonFile("CRM")("Header")("MessageID")

完整JSON转XML示例（处理多个文件） #

下面是遍历指定文件夹下所有JSON文件，提取值并生成XML的完整代码：

Sub ConvertJsonToXml()
    Dim fso As FileSystemObject
    Dim jsonFolder As Folder, jsonFile As File
    Dim jsonTextStream As TextStream
    Dim jsonContent As String
    Dim jsonObj As Object
    Dim xmlDoc As Object, xmlRoot As Object, xmlHeader As Object
    Dim outputXmlPath As String
    
    ' 初始化对象
    Set fso = New FileSystemObject
    Set xmlDoc = CreateObject("MSXML2.DOMDocument.6.0")
    xmlDoc.async = False
    xmlDoc.preserveWhiteSpace = True
    
    ' 输入输出路径设置（替换为你的实际路径）
    Dim inputJsonPath As String
    inputJsonPath = "C:\YourJsonFolder\"
    outputXmlPath = "C:\YourXmlOutput\"
    
    ' 创建输出文件夹（如果不存在）
    If Not fso.FolderExists(outputXmlPath) Then
        fso.CreateFolder outputXmlPath
    End If
    
    ' 遍历所有JSON文件
    Set jsonFolder = fso.GetFolder(inputJsonPath)
    For Each jsonFile In jsonFolder.Files
        If LCase(fso.GetExtensionName(jsonFile.Name)) = "json" Then
            ' 读取JSON文件内容
            Set jsonTextStream = jsonFile.OpenAsTextStream(ForReading)
            jsonContent = jsonTextStream.ReadAll
            jsonTextStream.Close
            
            ' 解析JSON
            Set jsonObj = JsonConverter.ParseJson(jsonContent)
            
            ' 创建XML结构
            xmlDoc.LoadXML("<Root></Root>")
            Set xmlRoot = xmlDoc.DocumentElement
            
            ' 创建Header节点并添加属性
            Set xmlHeader = xmlDoc.CreateElement("Header")
            xmlHeader.setAttribute "ID", jsonObj("CRM")("Header")("ID")
            xmlHeader.setAttribute "GSID", jsonObj("CRM")("Header")("GSID")
            xmlHeader.setAttribute "MessageID", jsonObj("CRM")("Header")("MessageID")
            xmlHeader.setAttribute "SenderID", jsonObj("CRM")("Header")("SenderID")
            xmlHeader.setAttribute "PayloadVersionID", jsonObj("CRM")("Header")("PayloadVersionID")
            xmlRoot.appendChild xmlHeader
            
            ' 可继续添加其他需要提取的节点（如Payload部分）
            
            ' 保存XML文件
            xmlDoc.Save outputXmlPath & fso.GetBaseName(jsonFile.Name) & ".xml"
        End If
    Next jsonFile
    
    MsgBox "转换完成！", vbInformation
End Sub

注意事项 #

• 确保已导入VBA-JSON模块（JsonConverter），将模块代码复制到你的VBA项目中即可使用。
• 所有变量建议显式声明类型（原代码中部分变量未指定类型，默认会变为Variant类型）。
• 文件操作后务必关闭流，避免资源占用。

内容的提问来源于stack exchange，提问作者Andi