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
我有一个程序可以搜索和收集(通过数组)特定作者及其 '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