VBA 修改XML文件
发布网友
发布时间：2022-04-23 06:03
共3个回答
热心网友
时间：2023-06-22 23:33
具体代码如下：代码需要引用 Microsfot XML，3.0
Sub testLoad()
Dim a As New DOMDocument
Dim sht As Worksheet
Dim sName As String, k As Long
a.Load Sheets("xml").[a2].Text
Dim b As IXMLDOMNode
Set b = a.SelectSingleNode(".//BODY")
k = 2
sName = b.ChildNodes.Item(0).BaseName '取表名
Set sht = ThisWorkbook.Worksheets.Add '添加表
sht.Name = sName '改表名
Sheets("xml").[a3] = sName '保存表名，后面再保存xml时需要用到
'写表头
sht.Cells(1, 1) = b.ChildNodes.Item(0).ChildNodes.Item(0).ChildNodes.Item(0).BaseName
sht.Cells(1, 2) = b.ChildNodes.Item(0).ChildNodes.Item(0).ChildNodes.Item(1).BaseName
sht.Cells(1, 3) = b.ChildNodes.Item(0).ChildNodes.Item(0).ChildNodes.Item(2).BaseName
'加载数据
For i = 0 To b.FirstChild.ChildNodes.Length - 1
sht.Cells(k + i, 1) = b.ChildNodes.Item(0).ChildNodes.Item(i).ChildNodes.Item(0).nodeTypedValue
sht.Cells(k + i, 2) = b.ChildNodes.Item(0).ChildNodes.Item(i).ChildNodes.Item(1).nodeTypedValue
sht.Cells(k + i, 3) = b.ChildNodes.Item(0).ChildNodes.Item(i).ChildNodes.Item(2).nodeTypedValue
Next
'重复上面的事情
sName = b.ChildNodes(2).BaseName
Set sht = ThisWorkbook.Worksheets.Add
sht.Name = sName
Sheets("xml").[a4] = sName
sht.Cells(1, 1) = b.ChildNodes.Item(2).ChildNodes.Item(0).ChildNodes.Item(0).BaseName
sht.Cells(1, 2) = b.ChildNodes.Item(2).ChildNodes.Item(0).ChildNodes.Item(1).BaseName
sht.Cells(1, 3) = b.ChildNodes.Item(2).ChildNodes.Item(0).ChildNodes.Item(2).BaseName
For i = 0 To b.ChildNodes(2).ChildNodes.Length - 1
sht.Cells(k + i, 1) = b.ChildNodes.Item(2).ChildNodes.Item(i).ChildNodes.Item(0).nodeTypedValue
sht.Cells(k + i, 2) = b.ChildNodes.Item(2).ChildNodes.Item(i).ChildNodes.Item(1).nodeTypedValue
sht.Cells(k + i, 3) = b.ChildNodes.Item(2).ChildNodes.Item(i).ChildNodes.Item(2).nodeTypedValue
Next
End Sub
Sub CreateNode(ByVal indent As Integer, ByVal parent As IXMLDOMNode, ByVal node_name As String, ByVal node_value As String)
Dim new_node As IXMLDOMNode
' Indent.
parent.appendChild parent.OwnerDocument.createTextNode(String(indent, Chr(9)))
' Create the new node.
Set new_node = parent.OwnerDocument.createElement(node_name)
' Set the node's text value.
new_node.Text = node_value
' Add the node to the parent.
parent.appendChild new_node
' Add a new line.
parent.appendChild parent.OwnerDocument.createTextNode(vbCrLf)
End Sub
Sub testSave()
Dim a As New DOMDocument
Dim b As IXMLDOMNode
Dim c As IXMLDOMNode
Dim sht As Worksheet
a.Load Sheets("xml").[a2].Text '载入xml数据
Set b = a.SelectSingleNode(".//BODY") '获取BODY节点数据
For Each c In b.ChildNodes(0).ChildNodes '移除原有的所有Node
b.ChildNodes(0).RemoveChild c
Next
For Each c In b.ChildNodes(2).ChildNodes
b.ChildNodes(2).RemoveChild c
Next
Set sht = Sheets(Sheets("xml").[a3].Text)
For i = 2 To sht.[a65536].End(xlUp).Row
Set c = a.createElement("ITEM")
c.appendChild a.createTextNode(vbCrLf) '添加回车换行符
b.ChildNodes(0).appendChild c
CreateNode 4, c, sht.[a1].Text, sht.Cells(i, 1) '添加数据,缩进4个tab
CreateNode 4, c, sht.[b1].Text, sht.Cells(i, 2)
CreateNode 4, c, sht.[c1].Text, sht.Cells(i, 3)
b.ChildNodes(0).LastChild.appendChild a.createTextNode(String(3, Chr(9))) '添加3个tab,缩进
b.ChildNodes(0).appendChild a.createTextNode(vbCrLf & String(3, Chr(9))) '换行与缩进3个tab，为下一次添加作准备
Next
Set c = a.SelectSingleNode(".//" & Sheets("xml").[a3].Text) '修改表格的COUNT属性
c.Attributes(0).Text = CStr(i - 2)
Set sht = Sheets(Sheets("xml").[a4].Text)
For i = 2 To sht.[a65536].End(xlUp).Row
Set c = a.createElement("ITEM")
c.appendChild a.createTextNode(vbCrLf)
b.ChildNodes(2).appendChild c
CreateNode 4, c, sht.[a1].Text, sht.Cells(i, 1)
CreateNode 4, c, sht.[b1].Text, sht.Cells(i, 2)
CreateNode 4, c, sht.[c1].Text, sht.Cells(i, 3)
b.ChildNodes(2).LastChild.appendChild a.createTextNode(String(3, Chr(9)))
b.ChildNodes(2).appendChild a.createTextNode(vbCrLf & String(3, Chr(9)))
Next
Set c = a.SelectSingleNode(".//" & Sheets("xml").[a4].Text) '修改表格的COUNT属性
c.Attributes(0).Text = CStr(i - 2)
Set c = a.SelectSingleNode(".//TBRQ") '修改文件修改日期
c.Text = Format(Date, "yyyy-mm-dd")
a.Save Sheets("xml").[a5].Text '保存xml文件
End Sub
热心网友
时间：2023-06-22 23:33
给你个示例代码，看着改下，
Sub ShowCustomXmlParts()
On Error GoTo Err
Dim cxp1 As CustomXMLPart
With ActiveDocument
' Example written for Word.
' Add a custom XML part and then load the XML from a file.
Set cxp1 = .CustomXMLParts.Add
cxp1.Load "c:\invoice.xml"
Set cxn = cxp1.SelectSingleNode("//*[@quantity < 4]")
' Insert a subtree before the single node selected previously.
cxn.InsertSubTreeBefore("<discounts><discount>0.10</discount></discounts>")
' Delete custom XML part.
cxp1.Delete
cxn.Delete
End With
Exit Sub
' Exception handling. Show the message and resume.
Err:
MsgBox (Err.Description)
Resume Next
End Sub追问这个对节点查找，好像不能修改节点内的数据，还是水平有限改不正确，有空帮改一下吧
热心网友
时间：2023-06-22 23:34
replace函数追问能写个语句吗？谢谢！例如该文件位于C：/2.XML
