使用 VBA (Excel) 从 XML DOM 对象中删除(子)节点
Remove (child) node from XML DOM object using VBA (Excel)
我正在使用模板创建非常复杂的 XML 文件,用可以在 Excel sheet 中输入的值替换特殊搜索字符串,然后存储 xml-文件.
Dim strInpPath As String
Dim strOutpPath As String
Dim fso
Dim f
Dim oDomRd As Object, oNode As Object, i As Long, oAtt As Object, oGroup As Object, oDomWr As Object
Dim oTest As Object
strInpPath = ActiveWorkbook.ActiveSheet.Cells(3, 4).Value
strOutputPath = ActiveWorkbook.ActiveSheet.Cells(4, 4).Value
Set oDomRd = CreateObject("MSXML2.DOMDocument")
oDomRd.Load strInpPath
Set oDomWr = CreateObject("MSXML2.DOMDocument")
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.OpenTextFile(strOutputPath, 2, True)
Set oGroup = oDomRd.SelectNodes("/")
Set oNode = oGroup.NextNode
If Not (oNode Is Nothing) Then
strout = oNode.XML
strout = ScanTable("_S_AND_R_TABLE_1", strout)
oDomRd.LoadXML (strout)
Set oGroup = oDomRd.SelectNodes("/")
Set oNode = oGroup.NextNode
If oNode.HasChildNodes() Then
Set oLists = oNode.DocumentElement
Run RemoveOptionalEmptyTags(oLists)
End If
strout = oNode.XML
f.write (strout)
Else
strout = "001 error reading file"
End If
MsgBox strout
End Function
有些字段值不是强制性的,因此可以留空。在这种情况下,第一个过程(scantable)输入“##REMOVE##”作为值。在第二步中,我想遍历整个 DOMObject 并删除值为“##REMOVE##”的节点。=18=]
对于第二步,我创建了一个过程:
Public Function RemoveOptionalEmptyTags(ByRef oLists)
For Each listnode In oLists.ChildNodes
If listnode.HasChildNodes() Then
Run RemoveOptionalEmptyTags(listnode)
Else
lcBasename = listnode.ParentNode.BaseName
lcText = listnode.Text
If lcText = "##REMOVE##" Then
listnode.ParentNode.RemoveChild listnode
Exit For
End If
End If
Next listnode
End Function
这很好用,唯一的问题是,节点没有被删除,它只是空的():
<Cdtr>
<Nm>Name Creditor</Nm>
<PstlAdr>
<Ctry>DE</Ctry>
<AdrLine>Street</AdrLine>
<AdrLine/>
</PstlAdr>
</Cdtr>
现在的问题是:
我怎样才能完全删除节点,所以它看起来像这样(第二个不见了):
<Cdtr>
<Nm>Name Creditor</Nm>
<PstlAdr>
<Ctry>DE</Ctry>
<AdrLine>Street</AdrLine>
</PstlAdr>
</Cdtr>
基本上 RemoveChild
语法是正确的:
{NodeToDelete}.ParentNode.RemoveChild {NodeToDelete}
但让我们重复 xml 结构并注意每个文本节点(如果存在)被视为其父节点的子节点(即更深的一个层次结构)。
<Cdtr> <!-- 0 documentElement -->
<Nm>Name Creditor</Nm> <!-- 1 ChildNode of Nm = 'Name Creditor' -->
<PstlAdr> <!-- 1 listNode.ParentNode.ParentNode -->
<Ctry>DE</Ctry> <!-- 2 ChildNode of Ctry = 'DE' -->
<AdrLine>Street</AdrLine> <!-- 2 ChildNode of AdrLine[1] = 'Street' -->
<AdrLine> <!-- 2 listNode.ParentNode to be removed -->
<!-- NODETEXT ##REMOVE## --> <!-- 3 ChildNode of AdrLine[2] -->
</AdrLine>
</PstlAdr>
</Cdtr>
通过
在 xml 层次结构(假设文本值)中深入到底部
listnode.ParentNode.RemoveChild listnode
您正在删除 AdrLine[2]
(级别 3)的文本子节点,即字符串 "##REMOVE##"
,
但不是容器节点 AdrLine[2]
(级别 2)。因此,您只删除了虚拟文本。
尽可能遵循您在函数 RemoveOptionalEmptyTags()
中的逻辑,您必须改为编写代码:
listNode.ParentNode.ParentNode.RemoveChild listNode.ParentNode
寻址 PstlAdr
(=级别 1)执行删除其 ChildNode AdrLine[2]
(即在级别 2)
自动包括删除级别 3 的虚拟字符串“##REMOVE”。
相关链接:
Obtain atrribute names from xml using VBA
我正在使用模板创建非常复杂的 XML 文件,用可以在 Excel sheet 中输入的值替换特殊搜索字符串,然后存储 xml-文件.
Dim strInpPath As String
Dim strOutpPath As String
Dim fso
Dim f
Dim oDomRd As Object, oNode As Object, i As Long, oAtt As Object, oGroup As Object, oDomWr As Object
Dim oTest As Object
strInpPath = ActiveWorkbook.ActiveSheet.Cells(3, 4).Value
strOutputPath = ActiveWorkbook.ActiveSheet.Cells(4, 4).Value
Set oDomRd = CreateObject("MSXML2.DOMDocument")
oDomRd.Load strInpPath
Set oDomWr = CreateObject("MSXML2.DOMDocument")
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.OpenTextFile(strOutputPath, 2, True)
Set oGroup = oDomRd.SelectNodes("/")
Set oNode = oGroup.NextNode
If Not (oNode Is Nothing) Then
strout = oNode.XML
strout = ScanTable("_S_AND_R_TABLE_1", strout)
oDomRd.LoadXML (strout)
Set oGroup = oDomRd.SelectNodes("/")
Set oNode = oGroup.NextNode
If oNode.HasChildNodes() Then
Set oLists = oNode.DocumentElement
Run RemoveOptionalEmptyTags(oLists)
End If
strout = oNode.XML
f.write (strout)
Else
strout = "001 error reading file"
End If
MsgBox strout
End Function
有些字段值不是强制性的,因此可以留空。在这种情况下,第一个过程(scantable)输入“##REMOVE##”作为值。在第二步中,我想遍历整个 DOMObject 并删除值为“##REMOVE##”的节点。=18=]
对于第二步,我创建了一个过程:
Public Function RemoveOptionalEmptyTags(ByRef oLists)
For Each listnode In oLists.ChildNodes
If listnode.HasChildNodes() Then
Run RemoveOptionalEmptyTags(listnode)
Else
lcBasename = listnode.ParentNode.BaseName
lcText = listnode.Text
If lcText = "##REMOVE##" Then
listnode.ParentNode.RemoveChild listnode
Exit For
End If
End If
Next listnode
End Function
这很好用,唯一的问题是,节点没有被删除,它只是空的():
<Cdtr>
<Nm>Name Creditor</Nm>
<PstlAdr>
<Ctry>DE</Ctry>
<AdrLine>Street</AdrLine>
<AdrLine/>
</PstlAdr>
</Cdtr>
现在的问题是: 我怎样才能完全删除节点,所以它看起来像这样(第二个不见了):
<Cdtr>
<Nm>Name Creditor</Nm>
<PstlAdr>
<Ctry>DE</Ctry>
<AdrLine>Street</AdrLine>
</PstlAdr>
</Cdtr>
基本上 RemoveChild
语法是正确的:
{NodeToDelete}.ParentNode.RemoveChild {NodeToDelete}
但让我们重复 xml 结构并注意每个文本节点(如果存在)被视为其父节点的子节点(即更深的一个层次结构)。
<Cdtr> <!-- 0 documentElement -->
<Nm>Name Creditor</Nm> <!-- 1 ChildNode of Nm = 'Name Creditor' -->
<PstlAdr> <!-- 1 listNode.ParentNode.ParentNode -->
<Ctry>DE</Ctry> <!-- 2 ChildNode of Ctry = 'DE' -->
<AdrLine>Street</AdrLine> <!-- 2 ChildNode of AdrLine[1] = 'Street' -->
<AdrLine> <!-- 2 listNode.ParentNode to be removed -->
<!-- NODETEXT ##REMOVE## --> <!-- 3 ChildNode of AdrLine[2] -->
</AdrLine>
</PstlAdr>
</Cdtr>
通过
在 xml 层次结构(假设文本值)中深入到底部 listnode.ParentNode.RemoveChild listnode
您正在删除 AdrLine[2]
(级别 3)的文本子节点,即字符串 "##REMOVE##"
,
但不是容器节点 AdrLine[2]
(级别 2)。因此,您只删除了虚拟文本。
尽可能遵循您在函数 RemoveOptionalEmptyTags()
中的逻辑,您必须改为编写代码:
listNode.ParentNode.ParentNode.RemoveChild listNode.ParentNode
寻址 PstlAdr
(=级别 1)执行删除其 ChildNode AdrLine[2]
(即在级别 2)
自动包括删除级别 3 的虚拟字符串“##REMOVE”。
相关链接:
Obtain atrribute names from xml using VBA