VBA DOM Variable Attribute in XPath

Question

I have a program that searches for and gathers (via array) a specific author and their 'BookType' and 'BookTitle' I am now trying to learn how to use the author's name - that I've stored in an array - as a variable in the XPath to get the 'Store Location'.

The biggest obstacle now is that the location only uses the author's last name. So I can split the string and all, but how would I feed it back into the XPath?

Below you'll see that <PublishedAuthor id='LASTNAME'> as opposed to their full name, so I cannot just put athr in the XPath this time. I keep getting an object error.

<?xml version="1.0"?>
<catalog>
<book id="Adventure">
   <author>Gambardella, Matthew</author>
   <title>XML Developer's Guide</title>
   <price>44.95</price>
   <misc>
        <Publisher id="5691">
            <PublisherLocation>Los Angeles</PublisherLocation>
        </Publisher>
        <PublishedAuthor id="Gambardella">
            <StoreLocation>Store B</StoreLocation>
        </PublishedAuthor>
    </misc>
</book>
<book id="Adventure">
   <author>Ralls, Kim</author>
   <title>Midnight Rain</title>
   <price>5.95</price>
   <misc>
        <Publisher id="4787">
            <PublisherLocation>New York</PublisherLocation>
        </Publisher>
        <PublishedAuthor id="Ralls">
            <StoreLocation>Store B</StoreLocation>
        </PublishedAuthor>
    </misc>
</book>
<book id="Adventure">
   <author>Boal, John</author>
   <title>Mist</title>
   <price>15.95</price>
   <misc>
        <Publisher id="8101">
            <PublisherLocation>New Mexico</PublisherLocation>
        </Publisher>
        <PublishedAuthor id="Boal">
            <StoreLocation>Store B</StoreLocation>
        </PublishedAuthor>
    </misc>
</book>
<book id="Mystery">
   <author>Ralls, Kim</author>
   <title>Some Mystery Book</title>
   <price>9.95</price>
   <misc>
        <Publisher id="6642">
            <PublisherLocation>New York</PublisherLocation>
        </Publisher>
        <PublishedAuthor id="Ralls">
            <StoreLocation>Store B</StoreLocation>
        </PublishedAuthor>
    </misc>
</book>
</catalog>

My code:

Option Explicit

Sub mySub()

Dim XMLFile As Variant
Dim Author As Variant
Dim athr As String, BookType As String, Title As String, StoreLocation As String
Dim AuthorArray() As String, BookTypeArray() As String, TitleArray() As String, StoreLocationArray() As String
Dim i As Long, x As Long, j As Long

Dim mainWorkBook As Workbook
Dim n As IXMLDOMNode
Set mainWorkBook = ActiveWorkbook
Set XMLFile = CreateObject("Microsoft.XMLDOM")
XMLFile.Load ("C:\Books.xml")


x = 1
j = 0

Set Author = XMLFile.SelectNodes("/catalog/book/author")
For i = 0 To (Author.Length - 1)
    ReDim Preserve AuthorArray(0 To i)
    ReDim Preserve BookTypeArray(0 To i)
    ReDim Preserve TitleArray(0 To i)
    ReDim Preserve StoreLocationArray(0 To i)

    athr = Author(i).Text
    BookType = Author(i).ParentNode.getAttribute("id")
    Title = Author(i).ParentNode.getElementsByTagName("title").Item(0).nodeTypedValue
    StoreLocation = Author(i).ParentNode.SelectSingleNode("misc/PublishedAuthor[@id=""" & athr & """]/StoreLocation").Text

    If athr = "Ralls, Kim" Then

        AuthorArray(j) = athr
        BookTypeArray(j) = BookType
        TitleArray(j) = Title
        StoreLocationArray(j) = StoreLocation

        j = j + 1
        x = x + 1
    End If
Next

Range("A3:A" & UBound(AuthorArray) + 1) = WorksheetFunction.Transpose(AuthorArray)
Range("B3:B" & UBound(BookTypeArray) + 1) = WorksheetFunction.Transpose(BookTypeArray)
Range("C3:C" & UBound(BookTypeArray) + 1) = WorksheetFunction.Transpose(TitleArray)
Range("D3:D" & UBound(BookTypeArray) + 1) = WorksheetFunction.Transpose(TitleArray)

Is there a better way to deal with an issue like this?

StoreLocation = Author(i).ParentNode.SelectSingleNode("misc/PublishedAuthor[@id=""" & athr & """]/StoreLocation").Text works flawlessly if the PublishedAuthor id was the same value as the author value.

Thank you for any guidance, help, or comments!

Answer 1

Maybe try your bottom line plus splitting?

Dim athrArry() as String = Split(athr, ", ")

StoreLocation = Author(i).ParentNode.SelectSingleNode("misc/PublishedAuthor[@id=""" & athrArry(0) & """]/StoreLocation").Text

Answer 2

Sub mySub()

Dim XMLFile As Variant
Dim Author As Variant
Dim athr As String, BookType As String, Title As String, StoreLocation As String
Dim AuthorArray() As String, BookTypeArray() As String, TitleArray() As String, StoreLocationArray() As String
Dim i As Long, x As Long, j As Long, pn As Object, loc As Object, arr, ln As String

Dim mainWorkBook As Workbook
Dim n As IXMLDOMNode
Set mainWorkBook = ActiveWorkbook
Set XMLFile = CreateObject("Microsoft.XMLDOM")
XMLFile.Load ("C:\Books.xml")

x = 1
j = 0

Set Author = XMLFile.SelectNodes("/catalog/book/author")
For i = 0 To (Author.Length - 1)

    athr = Author(i).Text

    If athr = "Ralls, Kim" Then

        Set pn = Author(i).ParentNode
        BookType = pn.getAttribute("id")
        Title = pn.getElementsByTagName("title").Item(0).nodeTypedValue

        Set loc = pn.SelectSingleNode("misc/PublishedAuthor[@id='" & athr & "']/StoreLocation")
        'not found on full name - try last name
        If loc Is Nothing Then
            'get the last name
            arr = Split(athr, ",")
            ln = Trim(arr(LBound(arr)))
            Set loc = pn.SelectSingleNode("misc/PublishedAuthor[@id='" & ln & "']/StoreLocation")
        End If

        If Not loc Is Nothing Then
            StoreLocation = loc.Text
        Else
            StoreLocation = "???"
        End If

        AddValue AuthorArray, athr
        AddValue BookTypeArray, BookType
        AddValue TitleArray, Title
        AddValue StoreLocationArray, StoreLocation

        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(BookTypeArray)
Range("C3").Resize(j, 1).Value = WorksheetFunction.Transpose(TitleArray)
Range("D3").Resize(j, 1).Value = WorksheetFunction.Transpose(StoreLocationArray)

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