如何解决如何使用 VBA 在 Excel 中打印所有子和父标记和值
下面是Xml文件
<?xml version="1.0" encoding="UTF-8"?>
<note>
<Example id= "exmaple111">
<to>Tove</to>
<from>Jani</from>
<heading>Reminder</heading>
<message>Don't forget me this weekend!</message>
<body>
<template> to be displayed..</template>
</body>
<Me>
<test> please print </test>
<test2> 22 </test2>
</Me>
<Extra> Extra </Extra>
</Example>
</note>
I have Written below Code
xml.Load (TextBox1.Value)
Dim XmlNode As IXMLDOMNode
Set XmlNode = xml.DocumentElement
ThisWorkbook.Worksheets("Sheet1").Range("B2").Value = XmlNode.xml
Set Books = xml.SelectNodes("/note/*")
For i = 0 To Books.Length - 1
For j = 0 To Books(i).ChildNodes.Length - 1
ThisWorkbook.Sheets("Sheet1").Range("A" & intCounter).Value = j + 1
ThisWorkbook.Sheets("Sheet1").Range("B" & intCounter).Value = Books(i).ChildNodes(j).NodeName ' Edit: instead of ".tagName"
ThisWorkbook.Sheets("Sheet1").Range("C" & intCounter).Value = Books(i).ChildNodes(j).Text
intCounter = intCounter + 1
Next
intCounter = intCounter + 1
Next
**但它只打印父节点，并在其中打印子节点而不是 value 。 但我需要孩子的名字也像下面这样 enter image description here
解决方法
Option Explicit
Sub ProcessDoc()
Dim xml As New MSXML2.DOMDocument
Dim ws As Worksheet,rng As Range
Dim depth As Integer,n As Long
Dim root As IXMLDOMNode
xml.LoadXML Range("A1").Value ' or TextBox1.Value
Set root = xml.SelectSingleNode("/")
Set rng = Sheet1.Range("B2")
depth = 0
n = 0
ProcessNode root,depth,rng,n
MsgBox n & " lines written to " & rng.Address,vbInformation
End Sub
Sub ProcessNode(parent As IXMLDOMNode,depth As Integer,rng As Range,n As Long)
Const MAX_DEPTH = 10 ' limit
Dim child As IXMLDOMNode
If parent Is Nothing Then
Exit Sub
ElseIf depth > MAX_DEPTH Then
MsgBox "Exceeded depth limit of " & MAX_DEPTH,vbCritical,"Depth=" & depth
ElseIf parent.HasChildNodes Then
For Each child In parent.ChildNodes
If child.NodeType = 3 Then 'NODE_TEXT
rng.Offset(n,0) = n + 1
rng.Offset(n,1) = parent.nodeName
rng.Offset(n,2) = child.Text
n = n + 1
ElseIf child.HasChildNodes Then
ProcessNode child,depth + 1,n ' recurse
End If
Next
End If
End Sub
解析 XML 节点名称和内容
"但它只是打印父节点和 用它打印孩子不值。 但我还需要子笔记（原文如此！）的名字。”
原帖没有考虑特殊的xml节点层次结构：
- 一个节点元素可以处理或不处理一个或多个子节点。
- 节点的子节点可以是文本元素或本身，例如一个节点元素。
- 节点的
.Text属性 alone 显示任何从属子节点的文本元素的连接字符串。
因此，多个层次结构级别上的每个完整解析操作都包括对子节点（.HasChildNodes 属性）的检查。
为了不让对嵌套级别的清晰视图，我紧急推荐一种递归方法。
这将通过主函数 listChildNodes() 进行演示。
此函数使用后期绑定，但也可以更改为早期绑定 通过将对象声明修改为精确的 MSXML2 声明类型。 请注意，早期绑定也会使用稍微不同的 DOMDocument 类型标识：
'(Early binding)
Dim xDoc As MSXML2.DOMDocument60 ' (or MSXML2.DOMDocument for old version 3.0)
Set xDoc = New MSXML2.DOMDocument60 ' set instance to memory
'LATE Binding
Dim xDoc As Object
Set xDoc = CreateObject("MSXML2.DOMDocument.6.0")
为了让其他用户避免写入和保存外部文件，可以通过 .LoadXML（而不是 .Load）直接加载 xlm 内容字符串
Dim XMLContentString as String
XMLContentString = "<?xml version="1.0" encoding="UTF-8"?><note>...</note>"
If xDoc.LoadXML(XMLContentString) Then
' ...
End If
示例调用（包括声明头）
作为附加功能，这个灵活的示例调用不仅显示
- 节点名称和
-
文本内容（包括可能的
<!-- comments -->）， - 但也在第一个目标列中输出一个类似章节的id。因此，
<Me>父节点 (id#6) 的从属子节点将被标记为6.1和6.2。
为了记住层次结构级别，在代码模块的声明头中定义了用户定义的类型。
（请注意，我使用了原始 xml 内容并没有更改节点 Example [@id='exmaple111'] 中可能的错字“exmaple111”）。*
当然最初的 XPath 搜索可以修改为任何其他子节点请求。
Option Explicit ' declaration head of code module
Type TLevels ' user defined type
levels() As Long
oldies() As String
End Type
Dim mem As TLevels ' declare array container for u.d.type
Sub ExampleCall()
ReDim mem.levels(0 To 4) ' define current level count
ReDim mem.oldies(0 To 4) ' define level ids
Dim xFileName As String
xFileName = ThisWorkbook.Path & "\xml\hierarchy.xml" ' << change to your needs
Dim xDoc As Object
Set xDoc = CreateObject("MSXML2.DOMDocument.6.0")
xDoc.async = False
xDoc.validateOnParse = False
If xDoc.Load(xFileName) Then
' [1] write xml info to array with exact or assumed items count
Dim data As Variant: ReDim data(1 To xDoc.SelectNodes("//*").Length,1 To 3)
' start call of recursive function
listChildNodes xDoc.DocumentElement.SelectSingleNode("Example[@id='exmaple111']"),data ' call help function listChildNodes
' [2] write results to target sheet ' << change to project's sheet Code(name)
With Sheet1
Dim r As Long,c As Long
r = UBound(data): c = UBound(data,2)
'write titles
.Range("A1").Resize(r,c) = "" ' clear result range
.Range("A1").Resize(1,c) = Split("ID,NodeName,Text",",") ' titles
'write data field array to target
.Range("A2").Resize(r,c) = data ' get 2-dim data array
End With
Else
MsgBox "Load Error " & xFileName
End If
Set xDoc = Nothing
End Sub
递归主函数listChildNodes()
注意后期绑定 XML 不允许使用 IXMLDOMNodeType 枚举常量
e.g. 1 ... `NODE_ELEMENT`,2 ... `NODE_ATTRIBUTE`,3 ... `NODE_TEXT` etc.,所以你必须取等价的数字。
Function listChildNodes(curNode As Object,_
ByRef v As Variant,_
Optional ByRef i As Long = 1,_
Optional curLvl As Long = 0 _
) As Boolean
' Purpose: assign the complete node structure to a 1-based 2-dim array
' Author: https://stackoverflow.com/users/6460297/t-m
' Date: 2021-04-04
' Escape clause
If curNode Is Nothing Then Exit Function
If i < 1 Then i = 1 ' one based items Counter
' Increase array size .. if needed
If i >= UBound(v) Then ' change array size if needed
Dim tmp As Variant
tmp = Application.Transpose(v) ' change rows to columns
ReDim Preserve tmp(1 To 3,1 To UBound(v) + 1000) ' increase row numbers
v = Application.Transpose(tmp) ' transpose back
Erase tmp
End If
' Declare variables
Dim child As Object ' late bound node object
Dim bDisplay As Boolean
Dim prevLvl As Long
' Distinguish between different node types
Select Case curNode.NodeType
Case 3 ' 3 ... NODE_TEXT
' ---------------------------------------------------------------------
' A. It's nothing but a TextNode (i.e. a parent node's firstChild!)
' ---------------------------------------------------------------------
' write pure text content (NODE_TEXT) of parent elements
v(i,3) = curNode.Text ' nodeValue of text node
' return boolean (i.e. yes,I'v found no further child elements)
listChildNodes = True
Exit Function
Case 1 ' 1 ... NODE_ELEMENT
' --------------------------------------------------------------
' B.1 NODE_ELEMENT WITHOUT text node immediately below,' a) i.e. node followed by another node element <..>,' (i.e. FirstChild.NodeType MUST not be of type NODE_TEXT = 3)
' b) or node element without any child node
' Note: a text content (NODE_TEXT) actually is a child node(!) to an element node
' (see section A. getting the FirstChild of a NODE_ELEMENT)
' --------------------------------------------------------------
If curNode.HasChildNodes Then
' a) display element followed by other Element nodes
If Not curNode.FirstChild.NodeType = 3 Then ' <>3 ... not a NODE_TEXT
bDisplay = True
End If
Else ' empty NODE_ELEMENT
' b) always display an empty node element
bDisplay = True
End If
If bDisplay Then
'write id + nodename
v(i,1) = getID(v,i,curLvl)
v(i,2) = curNode.nodeName
v(i,2) = v(i,2) & " " & getAtts(curNode)
i = i + 1
End If
' --------------------------------------------------------------
' B.2 check child nodes via recursion
' --------------------------------------------------------------
For Each child In curNode.ChildNodes
' ~~~~~~~~~~~~~~~~~~~~
' >> recursive call <<
' ~~~~~~~~~~~~~~~~~~~~
bDisplay = listChildNodes(child,v,curLvl + 1)
If bDisplay Then
'write id + nodename
v(i,curLvl)
v(i,2) = curNode.nodeName
v(i,2) & " " & getAtts(curNode)
i = i + 1 ' increment counter
End If
Next child
Case 8 ' 8 ... NODE_COMMENT
' --------------------------------------------------------------
' C. Comment
' --------------------------------------------------------------
v(i,curLvl)
v(i,2) = curNode.nodeName
v(i,3) = "'<!-- " & curNode.NodeValue & "-->"
i = i + 1 ' increment counter
End Select
End Function
帮助功能getID()
返回类似章节的级别编号（此处位于目标列 A:A）
Function getID(v,curLvl As Long) As String
'Purpose: return chapter-like level id
'Note : called by recursive function listChildNodes()
'Author : https://stackoverflow.com/users/6460297/t-m
'Date : 2021-04-04
'a) get previous level
Dim prevLvl As Long
If i > 1 Then prevLvl = UBound(Split(v(i - 1,1),".")) + 1
If curLvl Then
Dim lvl As Long
'b) reset previous levels
If curLvl < prevLvl Then
For lvl = curLvl + 1 To UBound(mem.levels)
mem.levels(lvl) = 0
Next
ElseIf curLvl > prevLvl Then
mem.levels(curLvl) = 0
End If
'c) increment counter
mem.levels(curLvl) = mem.levels(curLvl) + 1
'd) create id and remember old one
getID = "'" & Mid(mem.oldies(curLvl - 1),2) & IIf(curLvl > 1,".","") & mem.levels(curLvl)
mem.oldies(curLvl) = getID
End If
End Function
帮助功能getAtts()
返回属性名称和值的附加功能（列 B:B）：
Function getAtts(ByRef node As Object) As String
' Purpose: return attribute(s) string,e.g. 'id="example111"]'
' Note: called by recursive function listChildNodes()
' Author: https://stackoverflow.com/users/6460297/t-m
If node.nodeName = "#comment" Then Exit Function
Dim sAtts As String,ii As Long
If node.Attributes.Length > 0 Then
ii = 0: sAtts = ""
For ii = 0 To node.Attributes.Length - 1
sAtts = sAtts & "[@" & node.Attributes.Item(ii).nodeName & "='" & node.Attributes.Item(ii).NodeValue & "']"
Next ii
End If
' return function value
getAtts = sAtts
End Function
版权声明：本文内容由互联网用户自发贡献，该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容， 请发送邮件至 dio@foxmail.com 举报，一经查实，本站将立刻删除。
