如何在vba中用xml dom 插入节点?

XML DOM 规定可以了两种方法插入节点。

第一种是用appendChild方法。

第二种是用insertBefore方法。

其中appendChild方法是在结尾添加子节点,而insertBefore方法可以在任意的位置添加子节点。

比如有一段xml语句如下:

<bookstore>
<book category="COOKING">
  <title lang="en">Everyday Italian</title> 
  <author>Giada De Laurentiis</author> 
  <year>2005</year> 
  <price>30.00</price> 
</book>
<book category="CHILDREN">
  <title lang="en">Harry Potter</title> 
  <author>J K. Rowling</author> 
  <year>2005</year> 
  <price>29.99</price> 
</book>
<book category="WEB">
  <title lang="en">Learning XML</title> 
  <author>Erik T. Ray</author> 
  <year>2003</year> 
  <price>39.95</price> 
</book>
</bookstore>

如果要在category=”CHILDREN”的节点前面插入一个节点,可以使用如下的代码:

Sub QQ1722187970()
    Const NODE_ELEMENT = 1
    Const NODE_ATTRIBUTE = 2
    Const NODE_TEXT = 3
    Const NODE_COMMENT = 8
    Const NODE_DOCUMENT = 9
    '定义一个变量用于存储文本xml
    Dim sXml As String
    sXml = "<?xml version=""1.0"" encoding=""utf-8""?>" & _
    "<note>" & _
    "<to>George</to>" & _
    "<from>John</from>" & _
    "<heading>Reminder</heading>" & _
    "<body>Don't forget the meeting!</body>" & _
    "</note>"
    '定义一个变量用于存储xml文件
    Dim sPathXml As String
    sPathXml = Excel.ThisWorkbook.Path & "\test.xml"
    '定义一个解析xml的变量对象
    Dim oXml As Object
    Set oXml = VBA.CreateObject("Msxml2.DOMDocument.6.0")
'    Set oXml = VBA.CreateObject("Microsoft.XMLDOM")
    With oXml
        '不异步导入xml源
        .async = False
        '导入xml文件
        .Load (sPathXml)
        '导入xml文本
'        .LoadXML (sXml)
        With .parseError
            If .ErrorCode = 0 Then
                Debug.Print "解析成功"
                '解析成功
                '****************************
                '先找到要克隆的同级的节点
                Set oNode = oXml.getElementsByTagName("book")(1)
                '克隆一个新的节点
                Set oNodeNew = oNode.CloneNode(True)
                '将新的节点添加到指定的节点之前
                oNode.ParentNode.InsertBefore oNodeNew, oNode
                
                '****************************
            Else
                '如果解析错误,输出错误的原因
                Debug.Print .reason
            End If
        End With
        '定义一个存储最终xml的文件路径
        Dim sResultXml As String
        sResultXml = Excel.ThisWorkbook.Path & "\result.xml"
        '将解析修改后的xml存盘
        .Save sResultXml
    End With
End Sub

 

       

发表评论