VBA DOM XPath 中的变量属性

VBA DOM Variable Attribute in XPath

我有一个程序可以搜索和收集(通过数组)特定作者及其 'BookType' 和 'BookTitle' 我现在正在尝试学习如何使用作者的名字 - 我'已存储在数组中 - 作为 XPath 中的变量以获取 'Store Location'。

现在最大的障碍是该位置仅使用作者的姓氏。所以我可以拆分字符串和所有字符串,但我如何将它反馈回 XPath?

下面您会看到 <PublishedAuthor id='LASTNAME'> 而不是他们的全名,所以这次我不能只将 athr 放在 XPath 中。我一直收到对象错误。

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

我的代码:

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)

有没有更好的方法来处理这样的问题?

StoreLocation = Author(i).ParentNode.SelectSingleNode("misc/PublishedAuthor[@id=""" & athr & """]/StoreLocation").Text 如果 PublishedAuthor id 与作者值相同,则可以完美运行。

感谢您的任何指导、帮助或评论!

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

也许试试你的底线加拆分?

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

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