VBA XML DOM Search for an item that may not always exist



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!


No comments:

Post a Comment