VBA 如果 <object> 什么都没有

Question

我想测试一个对象，看它是否不存在。如果它不存在，我只想显示一个 MsgBox（或在单元格 A1 或其他内容中写入错误）。 XML 中不存在香蕉。

<?xml version="1.0"?>
<catalog>
<book id="Adventure">
   <author>Gambardella, Matthew</author>
   <title>XML Developer's Guide</title>
   <price>44.95</price>
</book>
<book id="Adventure">
   <author>Ralls, Kim</author>
   <title>Midnight Rain</title>
   <price>5.95</price>
</book>
<book id="Adventure">
   <author>Boal, John</author>
   <title>Mist</title>
   <price>15.95</price>
</book>
<book id="Mystery">
   <author>Ralls, Kim</author>
   <title>Some Mystery Book</title>
   <price>9.95</price>
</book>
</catalog>

测试代码：

Sub mySub()

Dim XMLFile As Variant
Dim Author As Object
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, loc2 As Object

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

x = 1
j = 0


Set Author = XMLFile.SelectNodes("/catalog/book/banana")

If Author Is Nothing Then
    MsgBox ("Not Found")
    Range("A1").Value = "Not found"
End If

If Not Author Is Nothing Then
    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

        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)
End If

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

为什么这个块什么都不做？我觉得它被 VBA 完全忽视了。我什至尝试在 If 语句中添加一个 End。

If Author Is Nothing Then
    MsgBox ("Not Found")
    Range("A1").Value = "Not found"
    End
End If

此外，错误也会在 If Not Author Is Nothing 语句中的打印范围行中引发。很奇怪。

Answer 1

您的循环仍在执行的原因很简单，就是 If Author Is Nothing 的计算结果为真。对 XMLFile.SelectNodes return 的调用是一个 IXMLDOMNodeList，它是一个可枚举的容器。事实上，它之所以能与 For Each 语法一起使用，就在于此。通常，由函数编辑的任何枚举 return 都会为您提供一个没有任何项目的可枚举对象，而不是空对象。 For Each 语法等效于这样做：

Do While Author.NextNode()
    '...
Loop

...或者...

For i = 0 To (Author.Length - 1)
    '...
Next i

For Each 的好处是更具可读性。

您得到的错误实际上与您提出的问题无关，如果您不纠正 XMLFile.SelectNodes("/catalog/book/banana") 的 return 值的检查将无法解决错误没有得到任何结果。错误在于如果未实例化则在循环后尝试使用数组（尽管添加的 End 会解决该问题）。

当你退出循环并到达这里时...

Range("A3").Resize(j, 1).Value = WorksheetFunction.Transpose(AuthorArray)
Range("B3").Resize(j, 1).Value = WorksheetFunction.Transpose(BookTypeArray)

...您的 AuthorArray 和 BookTypeArray 仅在您完成循环后才被初始化，因为您依赖 Sub AddValue 中的 ReDim Preserve 来初始化它们。这有2个解决方案。您可以在 return 值的测试中放置一个 Exit Sub：

If Author.Length = 0 Then
    MsgBox ("Not Found")
    Range("A1").Value = "Not found"
    Exit Sub
End If

或者您可以在函数开始时初始化数组。

AuthorArray = Split(vbNullString)
BookTypeArray = Split(vbNullString)

这还有一个额外的好处，就是允许您跳过调整数组大小的所有环节以确定它们是否已被初始化。 Split(vbNullString) 将 return 一个 UBound 为 -1 的数组（MyVariantArray = Array() 将对 Variant 数组执行相同的操作）。这允许您像这样重写 Sub AddValue：

Sub AddValue(arr, v)
    ReDim Preserve arr(UBound(arr) + 1)
    arr(UBound(arr)) = v
End Sub

最后，我会采纳@SOofXWLS 的建议和@barrowc 的建议并使用显式对象类型，因为您是后期绑定。这样你的 IntelliSense 至少会显示自动完成列表。如果您不知道 return 编辑了哪些类型的对象，只需按 F2 进入对象浏览器并检查：

如果您甚至不知道从哪里开始使用新的对象模型，您也可以使用这个快速而肮脏的技巧...

Dim XMLFile As Object
Set XMLFile = CreateObject("Microsoft.XMLDOM")
Debug.Print TypeName(XMLFile)   'DOMDocument

...然后...

Dim XMLFile As DOMDocument

VBA 如果 <object> 什么都没有

VBA If <object> Is Nothing

excel

vba

dom

xml-parsing