使用VBA为XML文档添加缺失的PartId1固定值节点

需求说明 #

• 检查XML文档中所有Del节点是否缺失PartId1节点
• 若缺失则添加PartId1节点，固定值为31245678934
• 新增的PartId1节点必须置于PartId节点之后

完整实现代码 #

Sub TestXML()

    Dim XDoc                    As MSXML2.DOMDocument
    Dim element                 As IXMLDOMElement
    Dim PartId                  As IXMLDOMElement
    Dim elements                As IXMLDOMSelection
    Dim xmlPath                 As String
    Dim PartId1                 As IXMLDOMElement
    Dim newPartId1              As IXMLDOMElement
    
    Set XDoc = New MSXML2.DOMDocument

    XDoc.async = False
    XDoc.validateOnParse = True
    
    xmlPath = "C:\DelCxl.xml"
    
    If Not XDoc.Load(xmlPath) Then
        MsgBox XDoc.parseError.reason, vbOKOnly, "Error " & XDoc.parseError.ErrorCode
        Exit Sub
    End If

    ' 选取所有Del节点
    Set elements = XDoc.SelectNodes("//Del")
  
    ' 遍历每个Del节点，检查并添加PartId1
    For Each element In elements
        Set PartId1 = element.SelectSingleNode("PartId1")
        If PartId1 Is Nothing Then
            ' 创建PartId1节点
            Set newPartId1 = XDoc.CreateElement("PartId1")
            ' 设置节点文本值
            newPartId1.Text = "31245678934"
            
            ' 获取当前Del下的PartId节点
            Set PartId = element.SelectSingleNode("PartId")
            
            If Not PartId Is Nothing Then
                ' 将PartId1插入到PartId的下一个节点之前（即PartId之后）
                element.InsertBefore newPartId1, PartId.NextSibling
            Else
                ' 若PartId不存在，直接追加到Del节点末尾
                element.AppendChild newPartId1
            End If
        End If
    Next element
    
    ' 保存修改后的XML文件
    XDoc.Save xmlPath
    Set XDoc = Nothing
    
    MsgBox "XML处理完成！", vbInformation
End Sub

关键代码解析 #

1. 节点创建与赋值：

   • 使用XDoc.CreateElement("PartId1")生成新节点
   • 通过newPartId1.Text = "31245678934"设置节点固定内容

2. 精准插入位置控制：

   • 利用PartId.NextSibling定位到PartId节点的下一个位置，通过InsertBefore方法将新节点插入到该位置之前，确保PartId1紧跟在PartId之后
   • 增加了对PartId不存在情况的兼容处理，避免运行报错

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