VBA XML DOM搜索可能并不总是存在的项目 [英] VBA XML DOM Search for an item that may not always exist

查看：220
本文介绍了VBA XML DOM搜索可能并不总是存在的项目的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！

问题描述

如果你为一个节点创建一个循环，这个节点可能并不总是它的父节点的一部分 - 在解析其他节点的数据时呢？



假设你有一个很大的文件与这些项目中的几个，但为了简单起见，我们使用这个XML（注意第一个书籍ID没有我们想要的节点，所以我们的循环已经失败）：

 <？xml version =1.0？> 
< catalog> 
< book id =AdventureISBN =00113version =13> 
< author> Ralls，Kim< / author> 
< title> XML开发人员指南< / title> 
< price> 44.95< / price> 
< misc> 
<编辑者id =9B> 
< editorBrand>部分编辑< / editorBrand> 
< editorEmphasis>最小< / editorEmphasis> 
< / editor> 
< / misc> 
< / book> 
< book id =AdventureISBN =00114version =14> 
< author> Ralls，Kim< / author> 
< title>午夜雨< / title> 
< price> 5.95< / price> 
< misc> 
< Publisher id =5691> 
< PublisherLocation>洛杉矶< / PublisherLocation> 
< / Publisher> 
< PublishedAuthor id =Ralls> 
< StoreLocation> Store A / 8< / StoreLocation> 
< seriesTitle> AAA< / seriesTitle> 
< store id =8> 
< copies> 26< / copies> 
< / store> 
< / misc> 
< / book> 
< book id =AdventureISBN =00115version =14> 
< author> Ralls，Kim< / author> 
< title> Mist< / title> 
< price> 15.95< / price> 
< misc> 
< Publisher id =8101> 
< PublisherLocation>新墨西哥< / 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 =MysteryISBN =00116version =13> 
< author> Bill，Simmons< / author> 
< title> NBA Insider< / title> 
< price> 16.99< / price> 
< misc> 
< editor id =11N> 
< editorBrand>完全编辑< / editorBrand> 
< editorEmphasis> Full< / editorEmphasis> 
< / editor> 
< / misc> 
< / book> 
< / catalog>

我们的VBA代码：

  Sub mySub（）
 
 Dim XMLFile As Variant 
 Dim seriesTitle As Variant 
 Dim series As String，As As String，Title As String，StoreLocation As String 
 Dim ISBN As String，as As String，storelc As String 
 Dim seriesArray（）As String，AuthorArray（）As String，BookTypeArray（）As String，TitleArray（）As String 
 Dim作为字符串，ISBNArray（）As String，copyArray（）As String 
 Dim i As Long，x As Long，j As Long，pn As Object，loc As Object，arr，ln As String，loc2 As对象
 
 Dim mainWorkBook As Workbook 
 Dim n As IXMLDOMNode 
设置mainWorkBook = ActiveWorkbook 
设置XMLFile = CreateObject（Microsoft.XMLDOM）
 XMLFile。 Load（C：\Books.xml）
 XMLFile.setPropertySelectionLanguage，XPath
 
x = 1 
j = 0 
 
设置seriesTitle = XMLFile.SelectNodes（/ catalog / book / misc / PublishedAuthor / seriesTitle）
对于i = 0 To（s eriesTitle.Length  -  1）
 
 series = seriesTitle（i）.Text 
 storelc = seriesTitle（i）.SelectSingleNode（store / copies）。Text 
 
如果系列=AAA或系列=BBB然后
 
设置pn = seriesTitle（i）.ParentNode 
 StoreLocation = pn.getElementsByTagName（StoreLocation）。Item（0） .nodeTypedValue 
作者= pn.ParentNode.ParentNode.getElementsByTagName（author）。Item（0）.nodeTypedValue 
 Title = pn.ParentNode.ParentNode.getElementsByTagName（title）。Item（0） .nodeTypedValue 
 ISBN = pn.ParentNode.ParentNode.getAttribute（ISBN）
 
设置loc = pn.SelectSingleNode（seriesTitle / store [@ id ='&存储和'] / copies）
如果loc is Nothing然后
 arr = Split（storelc，/）
 ln = Trim（arr（UBound（arr）））
设置loc = pn.SelectSingleNode（seriesTitle / store [@ id ='& ln&'] / copies）
 End If 
 
如果不是loc Is Nothing Then 
 copies = loc.Text 
 Else 
 copies =？ 
 End If 
 
 AddValue seriesArray，系列
 AddValue AuthorArray，作者
 AddValue TitleArray，Title 
 AddValue StoreLocationArray，StoreLocation 
 AddValue ISBNArray，ISBN 
 AddValue copiesArray，copy 
 
j = j + 1 
x = x + 1 
结束如果
下一个
 
范围（ （j，1）.Value = WorksheetFunction.Transpose（AuthorArray）
范围（B3）。调整大小（j，1）.Value = WorksheetFunction.Transpose（TitleArray）
范围（C3）。调整大小（j，1）.Value = WorksheetFunction.Transpose（ISBNArray）
范围（D3）。调整大小（j，1）.Value = WorksheetFunction.Transpose（seriesArray）
 Range（E3）。调整大小（j，1）.Value = WorksheetFunction.Transpose（StoreLocationArray）
范围（F3）。调整大小（j，1）.Value = WorksheetFunction.Transpose（copiesArray）
 
 End Sub 
 
'实用程序方法 - 根据需要调整数组大小，并添加一个新值
 
 Sub AddValue（arr，v）
 Dim i As Long 
i = -1 
错误恢复Next 
i = UBound（arr）+ 1 
 On Error GoTo 0 
如果i = -1则i = 0 
 ReDim保存arr（0 To i）
 arr （i）= v 
 End Sub

我的目标是搜索seriesTitle。所以我会专门创建一个For循环，搜索找到的项目的长度，然后解析系列标题以及ISBN，StoreLocation，作者，书名和副本。


  1. 如果seriesTitle存在，那么版本为14，我想打印出系列标题，ISBN，StoreLocation，作者，书名和副本。

  2. 如果seriesTitle不存在，那么版本13就是 - 我只想打印ISBN，作者和书名。

但问题是，对于存在的每个图书编号，不一定有seriesTitle - 我们可以画出的唯一关系是当'version = 13'没有系列标题




  • 如果没有对象创建For循环搜索，那么如何遍历整个文档？而当seriesTitle不存在时，您将如何继续添加ISBN，作者和书名数组？



解决方案

根据我的评论，似乎你会更好只需循环遍历所有< book> 元素并读取其所需值的子节点，而不是相当多地导航DOM树。 p> 

  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.setPropertySelectionLanguage ，XPath
 d.LoadXML Sheet1.Range（A1）。值
 
设置bks = d.SelectNodes（/ catalog / book）
对于每个bk在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 =?? 我不清楚你在做什么.... 
 
 Debug.Print vsn，isbn，storeLoc，seriesTitle，auth，title，copies 
 
下一个bk 
 
 End Sub 
 
'效用函数：如果存在，获取节点的值
函数GetTextSafely（el As Object，path As String）
 Dim nd ，rv 
设置nd = el.SelectSingleNode（路径）
如果不是没有，那么rv = nd.nodeTypedValue 
 GetTextSafely = rv 
结束函数


How do you create a loop for a node that might not always be part of its parent - while parsing data for other nodes?

Assume you have a very large file with several of these items, but for simplicity let's use this XML (notice the first 'book id' does not have the node we want, so our loop already fails):

<?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>

Our VBA Code:

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

My goal is to search for "seriesTitle". So I will specifically create a For loop that searches for the length of items found and then parse the "seriesTitle" along with ISBN, StoreLocation, Author, Book Title, and copies.

  1. If seriesTitle exists - it's version 14 then - I want to print out seriesTitle, ISBN, StoreLocation, Author, Book Title, and copies.
  2. If seriesTitle does NOT exist - it's version 13 then - I only want to print the ISBN, Author, and Book Title.

But the issue is that for each 'book id' that exists, there isn't necessarily a "seriesTitle" - the only relationship we can draw is that when the 'version=13' there is no seriesTitle.

  • How would you loop through an entire document if you don't have an object to create a For loop search with? And when "seriesTitle" doesn't exist, how would you continue to add items to the ISBN, Author, and Book Title array?

Thank you for teaching me with any helpful comments and suggestions!

解决方案

As per my comment, it seems like you would be better off just looping over all of the <book> elements and reading their child nodes for the required values, rather than navigating up and down the DOM tree quite so much.

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

这篇关于VBA XML DOM搜索可能并不总是存在的项目的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！

查看全文
相关文章
JavaScript最新文章
热门教程
热门工具
登录 关闭
扫码关注1秒登录
发送“验证码”获取 | 15天全站免登陆