如何修改VBA代码删除XML的ajson根标签并保留内部内容？

修改后的代码 #

你只需要调整XML加载部分的逻辑，兼容带ajson根标签的结构即可，修改后完整代码如下：

Sub Button1_Click()
    Dim fso As Object, ts As Object, doc As Object
    Dim data As Object, filename As String
    Dim ws As Worksheet
    Dim xmlContent As String
    Set ws = ActiveSheet
    
    ' 选择文件
    With Application.FileDialog(msoFileDialogFilePicker)
        If .Show <> -1 Then Exit Sub
        filename = .SelectedItems(1)
    End With
    
    ' 读取文件内容
    Set doc = CreateObject("MSXML2.DOMDocument.6.0")
    doc.async = False ' 禁用异步加载，避免加载不完整
    doc.validateOnParse = False ' 关闭校验，避免非标准XML报错
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.OpentextFile(filename)
    xmlContent = ts.readall
    ts.Close
    
    ' 兼容两种XML结构
    If Left(Trim(xmlContent), 6) = "<ajson" Then
        ' 带ajson根标签的新结构，直接加载即可
        doc.LoadXML xmlContent
    Else
        ' 旧结构，手动加root标签确保格式合法
        doc.LoadXML Replace(xmlContent, "<metadata>", "<root><metadata>", 1, 1) & "</root>"
    End If
    
    ' 提取data标签内容
    Dim s As String
    Set data = doc.getElementsByTagName("data")(0)
    s = data.XML
    
    ' 覆盖写入原文件
    Set ts = fso.CreateTextFile(filename, True)
    ts.Write s
    ts.Close
    
    MsgBox "处理完成！"
End Sub

核心修改说明 #

• 新增了XML内容前缀判断，如果检测到根标签是ajson，就直接加载原生内容，不需要额外拼接root标签，避免XML结构嵌套错误
• 给DOMDocument对象加了async = False和validateOnParse = False配置，避免部分场景下加载失败、解析报错的问题
• 原有提取data标签、写入文件的逻辑完全不需要改动，getElementsByTagName方法会自动在整个XML文档中查找对应标签，不管data是直接在根下还是嵌套在ajson节点内，都能正常定位。

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