VBA XML DOM 搜索可能并不总是存在的项目
VBA XML DOM Search for an item that may not always exist
如何为可能并不总是其一部分的节点创建循环 parent - 同时为其他节点解析数据？
假设你有一个非常大的文件，其中有几个项目，但为了简单起见，我们使用这个 XML（注意第一个 'book id' 没有我们想要的节点，所以我们的循环已经失败):
<?xml version="1.0"?>
<catalog>
<book id="Adventure" ISBN="00113" version="13">
<author>Ralls, Kim</author>
<title>XML Developer's Guide</title>
<price>44.95</price>
<misc>
<editor id="9B">
<editorBrand>Partial Edit</editorBrand>
<editorEmphasis>Minimal</editorEmphasis>
</editor>
</misc>
</book>
<book id="Adventure" ISBN="00114" version="14">
<author>Ralls, Kim</author>
<title>Midnight Rain</title>
<price>5.95</price>
<misc>
<Publisher id="5691">
<PublisherLocation>Los Angeles</PublisherLocation>
</Publisher>
<PublishedAuthor id="Ralls">
<StoreLocation>Store A/8</StoreLocation>
<seriesTitle>AAA</seriesTitle>
<store id="8">
<copies>26</copies>
</store>
</misc>
</book>
<book id="Adventure" ISBN="00115" version="14">
<author>Ralls, Kim</author>
<title>Mist</title>
<price>15.95</price>
<misc>
<Publisher id="8101">
<PublisherLocation>New Mexico</PublisherLocation>
</Publisher>
<PublishedAuthor id="Ralls">
<StoreLocation>Market C/13</StoreLocation>
<seriesTitle>BBB</seriesTitle>
<store id="9">
<copies>150</copies>
</store>
<store id="13">
<copies>60</copies>
</store>
</PublishedAuthor>
</misc>
</book>
<book id="Mystery" ISBN="00116" version="13">
<author>Bill, Simmons</author>
<title>NBA Insider</title>
<price>16.99</price>
<misc>
<editor id="11N">
<editorBrand>Full Edit</editorBrand>
<editorEmphasis>Full</editorEmphasis>
</editor>
</misc>
</book>
</catalog>
我们的VBA代码：
Sub mySub()
Dim XMLFile As Variant
Dim seriesTitle As Variant
Dim series As String, Author As String, Title As String, StoreLocation As String
Dim ISBN As String, copies As String, storelc As String
Dim seriesArray() As String, AuthorArray() As String, BookTypeArray() As String, TitleArray() As String
Dim StoreLocationArray() As String, ISBNArray() As String, copiesArray() As String
Dim i As Long, x As Long, j As Long, pn As Object, loc As Object, arr, ln As String, loc2 As Object
Dim mainWorkBook As Workbook
Dim n As IXMLDOMNode
Set mainWorkBook = ActiveWorkbook
Set XMLFile = CreateObject("Microsoft.XMLDOM")
XMLFile.Load ("C:\Books.xml")
XMLFile.setProperty "SelectionLanguage", "XPath"
x = 1
j = 0
Set seriesTitle = XMLFile.SelectNodes("/catalog/book/misc/PublishedAuthor/seriesTitle")
For i = 0 To (seriesTitle.Length - 1)
series = seriesTitle(i).Text
storelc = seriesTitle(i).SelectSingleNode("store/copies").Text
If series = "AAA" Or series = "BBB" Then
Set pn = seriesTitle(i).ParentNode
StoreLocation = pn.getElementsByTagName("StoreLocation").Item(0).nodeTypedValue
Author = pn.ParentNode.ParentNode.getElementsByTagName("author").Item(0).nodeTypedValue
Title = pn.ParentNode.ParentNode.getElementsByTagName("title").Item(0).nodeTypedValue
ISBN = pn.ParentNode.ParentNode.getAttribute("ISBN")
Set loc = pn.SelectSingleNode("seriesTitle/store[@id='" & storelc & "']/copies")
If loc Is Nothing Then
arr = Split(storelc, "/")
ln = Trim(arr(UBound(arr)))
Set loc = pn.SelectSingleNode("seriesTitle/store[@id='" & ln & "']/copies")
End If
If Not loc Is Nothing Then
copies = loc.Text
Else
copies = "?"
End If
AddValue seriesArray, series
AddValue AuthorArray, Author
AddValue TitleArray, Title
AddValue StoreLocationArray, StoreLocation
AddValue ISBNArray, ISBN
AddValue copiesArray, copies
j = j + 1
x = x + 1
End If
Next
Range("A3").Resize(j, 1).Value = WorksheetFunction.Transpose(AuthorArray)
Range("B3").Resize(j, 1).Value = WorksheetFunction.Transpose(TitleArray)
Range("C3").Resize(j, 1).Value = WorksheetFunction.Transpose(ISBNArray)
Range("D3").Resize(j, 1).Value = WorksheetFunction.Transpose(seriesArray)
Range("E3").Resize(j, 1).Value = WorksheetFunction.Transpose(StoreLocationArray)
Range("F3").Resize(j, 1).Value = WorksheetFunction.Transpose(copiesArray)
End Sub
'Utility method - resize an array as needed, and add a new value
Sub AddValue(arr, v)
Dim i As Long
i = -1
On Error Resume Next
i = UBound(arr) + 1
On Error GoTo 0
If i = -1 Then i = 0
ReDim Preserve arr(0 To i)
arr(i) = v
End Sub
我的目标是搜索 "seriesTitle"。因此，我将专门创建一个 For 循环来搜索找到的项目的长度，然后解析 "seriesTitle" 以及 ISBN、StoreLocation、作者、书名和副本。
- 如果 seriesTitle 存在 - 它是第 14 版 - 我想打印出 seriesTitle、ISBN、StoreLocation、作者、书名和副本。
- 如果 seriesTitle 不存在 - 那么它是第 13 版 - 我只想打印 ISBN、作者和书名。
但问题在于，对于每个存在的 'book id'，不一定存在 "seriesTitle" - 我们唯一可以得出的关系是当 'version=13' 不存在时系列标题。
- 如果您没有 object 来创建 For 循环搜索，您将如何遍历整个文档？当 "seriesTitle" 不存在时，您将如何继续向 ISBN、作者和书名数组添加项目？
感谢您给我任何有用的意见和建议！
首先您的 xml 包含一个错误。您缺少 的结束标记。请参阅下面的新 XML
<?xml version="1.0"?>
<catalog>
<book id="Adventure" ISBN="00113" version="13">
<author>Ralls, Kim</author>
<title>XML Developer's Guide</title>
<price>44.95</price>
<misc>
<editor id="9B">
<editorBrand>Partial Edit</editorBrand>
<editorEmphasis>Minimal</editorEmphasis>
</editor>
</misc>
</book>
<book id="Adventure" ISBN="00114" version="14">
<author>Ralls, Kim</author>
<title>Midnight Rain</title>
<price>5.95</price>
<misc>
<Publisher id="5691">
<PublisherLocation>Los Angeles</PublisherLocation>
</Publisher>
<PublishedAuthor id="Ralls">
<StoreLocation>Store A/8</StoreLocation>
<seriesTitle>AAA</seriesTitle>
<store id="8">
<copies>26</copies>
</store>
</PublishedAuthor>
</misc>
</book>
<book id="Adventure" ISBN="00115" version="14">
<author>Ralls, Kim</author>
<title>Mist</title>
<price>15.95</price>
<misc>
<Publisher id="8101">
<PublisherLocation>New Mexico</PublisherLocation>
</Publisher>
<PublishedAuthor id="Ralls">
<StoreLocation>Market C/13</StoreLocation>
<seriesTitle>BBB</seriesTitle>
<store id="9">
<copies>150</copies>
</store>
<store id="13">
<copies>60</copies>
</store>
</PublishedAuthor>
</misc>
</book>
<book id="Mystery" ISBN="00116" version="13">
<author>Bill, Simmons</author>
<title>NBA Insider</title>
<price>16.99</price>
<misc>
<editor id="11N">
<editorBrand>Full Edit</editorBrand>
<editorEmphasis>Full</editorEmphasis>
</editor>
</misc>
</book>
</catalog>
当您有多个级别 object 并且缺少级别时，您必须一次搜索一个级别。每本书都有一个 "misc" 标签。所以你首先必须通过 "misc" 来枚举书籍。然后测试 child 是否存在。
Set misc = XMLFile.SelectNodes("catalog/book/misc")
For a = 0 To (misc.Length - 1)
Set publishedAuthor = XMLFile.SelectNodes("/catalog/book/misc/PublishedAuthor/seriesTitle")
If Not publishedAuthor Is Nothing Then
End If
Next a
根据我的评论，看起来你最好只是遍历所有 <book> 元素并读取它们的子节点以获得所需的值，而不是上下导航 DOM 树真多
Sub Tester()
Dim d As New MSXML2.DOMDocument
Dim bks As MSXML2.IXMLDOMNodeList
Dim bk As Object
Dim cat As Object, sertitle
Dim isbn, storeLoc, auth, seriesTitle, vsn, copies, title
d.setProperty "SelectionLanguage", "XPath"
d.LoadXML Sheet1.Range("A1").Value
Set bks = d.SelectNodes("/catalog/book")
For Each bk In bks
vsn = bk.getAttribute("version")
isbn = bk.getAttribute("ISBN")
title = GetTextSafely(bk, "title")
storeLoc = GetTextSafely(bk, "misc/PublishedAuthor/StoreLocation")
seriesTitle = GetTextSafely(bk, "misc/PublishedAuthor/seriesTitle")
auth = GetTextSafely(bk, "author")
copies = "??" ' I'm unclear exactly what you're doing here....
Debug.Print vsn, isbn, storeLoc, seriesTitle, auth, title, copies
Next bk
End Sub
'utility function: get a node's value if it exists
Function GetTextSafely(el As Object, path As String)
Dim nd, rv
Set nd = el.SelectSingleNode(path)
If Not nd Is Nothing Then rv = nd.nodeTypedValue
GetTextSafely = rv
End Function
如何为可能并不总是其一部分的节点创建循环 parent - 同时为其他节点解析数据？
假设你有一个非常大的文件，其中有几个项目，但为了简单起见，我们使用这个 XML（注意第一个 'book id' 没有我们想要的节点，所以我们的循环已经失败):
<?xml version="1.0"?>
<catalog>
<book id="Adventure" ISBN="00113" version="13">
<author>Ralls, Kim</author>
<title>XML Developer's Guide</title>
<price>44.95</price>
<misc>
<editor id="9B">
<editorBrand>Partial Edit</editorBrand>
<editorEmphasis>Minimal</editorEmphasis>
</editor>
</misc>
</book>
<book id="Adventure" ISBN="00114" version="14">
<author>Ralls, Kim</author>
<title>Midnight Rain</title>
<price>5.95</price>
<misc>
<Publisher id="5691">
<PublisherLocation>Los Angeles</PublisherLocation>
</Publisher>
<PublishedAuthor id="Ralls">
<StoreLocation>Store A/8</StoreLocation>
<seriesTitle>AAA</seriesTitle>
<store id="8">
<copies>26</copies>
</store>
</misc>
</book>
<book id="Adventure" ISBN="00115" version="14">
<author>Ralls, Kim</author>
<title>Mist</title>
<price>15.95</price>
<misc>
<Publisher id="8101">
<PublisherLocation>New Mexico</PublisherLocation>
</Publisher>
<PublishedAuthor id="Ralls">
<StoreLocation>Market C/13</StoreLocation>
<seriesTitle>BBB</seriesTitle>
<store id="9">
<copies>150</copies>
</store>
<store id="13">
<copies>60</copies>
</store>
</PublishedAuthor>
</misc>
</book>
<book id="Mystery" ISBN="00116" version="13">
<author>Bill, Simmons</author>
<title>NBA Insider</title>
<price>16.99</price>
<misc>
<editor id="11N">
<editorBrand>Full Edit</editorBrand>
<editorEmphasis>Full</editorEmphasis>
</editor>
</misc>
</book>
</catalog>
我们的VBA代码：
Sub mySub()
Dim XMLFile As Variant
Dim seriesTitle As Variant
Dim series As String, Author As String, Title As String, StoreLocation As String
Dim ISBN As String, copies As String, storelc As String
Dim seriesArray() As String, AuthorArray() As String, BookTypeArray() As String, TitleArray() As String
Dim StoreLocationArray() As String, ISBNArray() As String, copiesArray() As String
Dim i As Long, x As Long, j As Long, pn As Object, loc As Object, arr, ln As String, loc2 As Object
Dim mainWorkBook As Workbook
Dim n As IXMLDOMNode
Set mainWorkBook = ActiveWorkbook
Set XMLFile = CreateObject("Microsoft.XMLDOM")
XMLFile.Load ("C:\Books.xml")
XMLFile.setProperty "SelectionLanguage", "XPath"
x = 1
j = 0
Set seriesTitle = XMLFile.SelectNodes("/catalog/book/misc/PublishedAuthor/seriesTitle")
For i = 0 To (seriesTitle.Length - 1)
series = seriesTitle(i).Text
storelc = seriesTitle(i).SelectSingleNode("store/copies").Text
If series = "AAA" Or series = "BBB" Then
Set pn = seriesTitle(i).ParentNode
StoreLocation = pn.getElementsByTagName("StoreLocation").Item(0).nodeTypedValue
Author = pn.ParentNode.ParentNode.getElementsByTagName("author").Item(0).nodeTypedValue
Title = pn.ParentNode.ParentNode.getElementsByTagName("title").Item(0).nodeTypedValue
ISBN = pn.ParentNode.ParentNode.getAttribute("ISBN")
Set loc = pn.SelectSingleNode("seriesTitle/store[@id='" & storelc & "']/copies")
If loc Is Nothing Then
arr = Split(storelc, "/")
ln = Trim(arr(UBound(arr)))
Set loc = pn.SelectSingleNode("seriesTitle/store[@id='" & ln & "']/copies")
End If
If Not loc Is Nothing Then
copies = loc.Text
Else
copies = "?"
End If
AddValue seriesArray, series
AddValue AuthorArray, Author
AddValue TitleArray, Title
AddValue StoreLocationArray, StoreLocation
AddValue ISBNArray, ISBN
AddValue copiesArray, copies
j = j + 1
x = x + 1
End If
Next
Range("A3").Resize(j, 1).Value = WorksheetFunction.Transpose(AuthorArray)
Range("B3").Resize(j, 1).Value = WorksheetFunction.Transpose(TitleArray)
Range("C3").Resize(j, 1).Value = WorksheetFunction.Transpose(ISBNArray)
Range("D3").Resize(j, 1).Value = WorksheetFunction.Transpose(seriesArray)
Range("E3").Resize(j, 1).Value = WorksheetFunction.Transpose(StoreLocationArray)
Range("F3").Resize(j, 1).Value = WorksheetFunction.Transpose(copiesArray)
End Sub
'Utility method - resize an array as needed, and add a new value
Sub AddValue(arr, v)
Dim i As Long
i = -1
On Error Resume Next
i = UBound(arr) + 1
On Error GoTo 0
If i = -1 Then i = 0
ReDim Preserve arr(0 To i)
arr(i) = v
End Sub
我的目标是搜索 "seriesTitle"。因此，我将专门创建一个 For 循环来搜索找到的项目的长度，然后解析 "seriesTitle" 以及 ISBN、StoreLocation、作者、书名和副本。
- 如果 seriesTitle 存在 - 它是第 14 版 - 我想打印出 seriesTitle、ISBN、StoreLocation、作者、书名和副本。
- 如果 seriesTitle 不存在 - 那么它是第 13 版 - 我只想打印 ISBN、作者和书名。
但问题在于，对于每个存在的 'book id'，不一定存在 "seriesTitle" - 我们唯一可以得出的关系是当 'version=13' 不存在时系列标题。
- 如果您没有 object 来创建 For 循环搜索，您将如何遍历整个文档？当 "seriesTitle" 不存在时，您将如何继续向 ISBN、作者和书名数组添加项目？
感谢您给我任何有用的意见和建议！
首先您的 xml 包含一个错误。您缺少 的结束标记。请参阅下面的新 XML
<?xml version="1.0"?>
<catalog>
<book id="Adventure" ISBN="00113" version="13">
<author>Ralls, Kim</author>
<title>XML Developer's Guide</title>
<price>44.95</price>
<misc>
<editor id="9B">
<editorBrand>Partial Edit</editorBrand>
<editorEmphasis>Minimal</editorEmphasis>
</editor>
</misc>
</book>
<book id="Adventure" ISBN="00114" version="14">
<author>Ralls, Kim</author>
<title>Midnight Rain</title>
<price>5.95</price>
<misc>
<Publisher id="5691">
<PublisherLocation>Los Angeles</PublisherLocation>
</Publisher>
<PublishedAuthor id="Ralls">
<StoreLocation>Store A/8</StoreLocation>
<seriesTitle>AAA</seriesTitle>
<store id="8">
<copies>26</copies>
</store>
</PublishedAuthor>
</misc>
</book>
<book id="Adventure" ISBN="00115" version="14">
<author>Ralls, Kim</author>
<title>Mist</title>
<price>15.95</price>
<misc>
<Publisher id="8101">
<PublisherLocation>New Mexico</PublisherLocation>
</Publisher>
<PublishedAuthor id="Ralls">
<StoreLocation>Market C/13</StoreLocation>
<seriesTitle>BBB</seriesTitle>
<store id="9">
<copies>150</copies>
</store>
<store id="13">
<copies>60</copies>
</store>
</PublishedAuthor>
</misc>
</book>
<book id="Mystery" ISBN="00116" version="13">
<author>Bill, Simmons</author>
<title>NBA Insider</title>
<price>16.99</price>
<misc>
<editor id="11N">
<editorBrand>Full Edit</editorBrand>
<editorEmphasis>Full</editorEmphasis>
</editor>
</misc>
</book>
</catalog>
当您有多个级别 object 并且缺少级别时，您必须一次搜索一个级别。每本书都有一个 "misc" 标签。所以你首先必须通过 "misc" 来枚举书籍。然后测试 child 是否存在。
Set misc = XMLFile.SelectNodes("catalog/book/misc")
For a = 0 To (misc.Length - 1)
Set publishedAuthor = XMLFile.SelectNodes("/catalog/book/misc/PublishedAuthor/seriesTitle")
If Not publishedAuthor Is Nothing Then
End If
Next a
根据我的评论，看起来你最好只是遍历所有 <book> 元素并读取它们的子节点以获得所需的值，而不是上下导航 DOM 树真多
Sub Tester()
Dim d As New MSXML2.DOMDocument
Dim bks As MSXML2.IXMLDOMNodeList
Dim bk As Object
Dim cat As Object, sertitle
Dim isbn, storeLoc, auth, seriesTitle, vsn, copies, title
d.setProperty "SelectionLanguage", "XPath"
d.LoadXML Sheet1.Range("A1").Value
Set bks = d.SelectNodes("/catalog/book")
For Each bk In bks
vsn = bk.getAttribute("version")
isbn = bk.getAttribute("ISBN")
title = GetTextSafely(bk, "title")
storeLoc = GetTextSafely(bk, "misc/PublishedAuthor/StoreLocation")
seriesTitle = GetTextSafely(bk, "misc/PublishedAuthor/seriesTitle")
auth = GetTextSafely(bk, "author")
copies = "??" ' I'm unclear exactly what you're doing here....
Debug.Print vsn, isbn, storeLoc, seriesTitle, auth, title, copies
Next bk
End Sub
'utility function: get a node's value if it exists
Function GetTextSafely(el As Object, path As String)
Dim nd, rv
Set nd = el.SelectSingleNode(path)
If Not nd Is Nothing Then rv = nd.nodeTypedValue
GetTextSafely = rv
End Function