批量给xml文件添加子节点

背景：税局的开票软件是通过一种叫xml格式的文件来上传的，一个文件可以开具多张发票，也可以多个文件开具多个发票，文件内容格式大概长下面这样：

<?xml version="1.0" encoding="UTF-8"?>
<books>
  <book>
    <name>哈里波特</name>
    <price>10</price>
    <memo>这是一本很好看的书。</memo>
  </book>
  <book id="B02">
    <name>三国演义</name>
    <price>10</price>
    <memo>四大名著之一。</memo>
  </book>
  <book id="B03">
    <name>水浒</name>
    <price>6</price>
    <memo>四大名著之一。</memo>
  </book>
  <book id="B04">
    <name>红楼</name>
    <price>5</price>
    <memo>四大名著之一。</memo>
  </book>
</books>

随着时间发展，发票内容有可能会发生变化，所以有可能需要增加类目，譬如说像上面的书单，每本书需要增加一个出版社标签，一个两个还好，但文件多起来，人工操作实在不太方便且工作量大，所以就有了这个小工具。

编译后的可执行程序（因为涉及清空生成文档操作，杀毒软件可能报毒）：

下载:https://busy.lanzoui.com/iZKoouq46pg

密码:dxeb

源代码我也贴下，有兴趣的可以拿去自己修改：

清空生成修改后文件的文件夹：

'清空需生成文件的文件夹
Sub deleteMyFile(generatePath As String)
    Dim fs As Object
    Set fs = CreateObject("scripting.filesystemobject")
    fs.deleteFile (generatePath & "\*.*")
    fs.DeleteFolder (generatePath & "\*.*")
End Sub

修改xml文件：

'修改xml文件
Sub newNode(fileName As String, originalPath As String, generatePath As String, fatherNode As String, childNode As String, childNodeText As String)
    '创建文档对象、节点、节点列表
    Set xmlDom = CreateObject("msxml2.domdocument")
    Dim xmlNode As MSXML2.IXMLDOMNode
    Dim xmlNodeList As MSXML2.IXMLDOMNodeList
    '加载xml文档
    xmlDom.Load (originalPath & "\" & fileName)
    'MsgBox ("C:\Users\刘学\Desktop\xml\file\" & fileName)
    '选择多个节点
    Set xmlNodeList = xmlDom.SelectNodes("//" + fatherNode)
    Set xmlNode = Nothing
    For Each xmlNode In xmlNodeList
        ' 遍历内容
        '新建节点
        Set objNode = xmlDom.createNode(1, childNode, "")
        'Set objNode = xmlDom.createElement("Se")
        '编辑节点内容
        objNode.Text = childNodeText
        '添加子节点
        xmlNode.appendChild (objNode)
    Next
    xmlDom.Save (generatePath & "\" & fileName)
End Sub

批量生成：

Private Sub generate_Click()
    Dim origionalPath As String
    Dim generatePath As String
    Dim fatherNode As String
    Dim childNode As String
    Dim childNodeText As String
    origionalPath = TextBox1.Text
    generatePath = TextBox2.Text
    fatherNode = TextBox3.Text
    childNode = TextBox4.Text
    childNodeText = TextBox5.Text
    'MsgBox origionalPath
    'MsgBox generatePath
    'MsgBox fatherNode
    'MsgBox childNode
    'MsgBox childNodeText
    
    
    Dim MyFile As String
    Dim fileName As String
    Dim s As String
    Dim count As Integer
    
    '拟遍历文件夹的路径
    MyFile = Dir(origionalPath + "\" + "*.xml")
    'MsgBox MyFile
    
    '读入文件夹中的第一个.xml文件
    count = count + 1       '记录文件的个数
    s = s & count & "、" & MyFile
    
    '删除done文件夹下已有的文件
    deleteMyFile (generatePath)
    
    Do While MyFile <> ""
        'MsgBox MyFile
        '调用newNode函数修改xml文件
        Call newNode(MyFile, origionalPath, generatePath, fatherNode, childNode, childNodeText)
        
        MyFile = Dir        '第二次读入的时候不用写参数
        If MyFile = "" Then
            Exit Do         '当MyFile为空的时候就说明已经遍历完了，这时退出Do，否则还要运行一遍
        End If
        count = count + 1
        If count Mod 2 <> 1 Then
            s = s & vbTab & count & "、" & MyFile
        Else
            s = s & vbCrLf & count & "、" & MyFile
        End If
    Loop
    Debug.Print s
    MsgBox "已完成修改，修改的文件分别是：" & Chr(10) & s
    
    
End Sub