带有或带有块的对象变量未设置

Question

我有一个要解析的 xml 文件：

这是xml文件内容

<MYSTUFF>
<COMPANYNAMES>
<COMPANYNAME>JUMPIN (JIMMY) LIMITED</COMPANYNAME>
<COMPANYNAME>BLADE RUNNER'S TRANSPORT</COMPANYNAME>
<COMPANYNAME>P Griffiths & Sons</COMPANYNAME>
<COMPANYNAME>SOMETIMES, NEVER</COMPANYNAME>
<COMPANYNAME>MASTER/CLASS</COMPANYNAME>
</COMPANYNAMES>
<FIRSTNAMES>
<FIRSTNAME>Richard</FIRSTNAME>
<FIRSTNAME>Jo & hn</FIRSTNAME>
<FIRSTNAME>Paul</FIRSTNAME>
<FIRSTNAME>Geo, rge</FIRSTNAME>
<FIRSTNAME>Ringo</FIRSTNAME>
</FIRSTNAMES>
<LASTNAMES>
<LASTNAME>Davies'</LASTNAME>
<LASTNAME>Lennon</LASTNAME>
<LASTNAME>McCartney(3)</LASTNAME>
<LASTNAME>Harrison</LASTNAME>
<LASTNAME>St/ar</LASTNAME>
</LASTNAMES>
</MYSTUFF>

这是代码：

Dim XDoc As Object

Set XDoc = CreateObject("MSXML2.DOMDocument")
XDoc.async = False: XDoc.validateOnParse = False
XDoc.Load (ThisWorkbook.Path & "\test.xml")

'Get Document Elements
Set lists = XDoc.DocumentElement

'Traverse all elements 2 branches deep
For Each listNode In lists.ChildNodes
    For Each fieldNode In listNode.ChildNodes
        Debug.Print "[" & fieldNode.BaseName & "] = [" & fieldNode.Text & "]"
    Next fieldNode
Next listNode

Set XDoc = Nothing

我正在获取对象变量 with or with block not set on this line:

For Each listNode In lists.ChildNodes

Answer 1

您的 XML 文件未正确加载。

a) 我想您的 XML 文件以 <?xml version="1.0" encoding="utf-8"?> 之类的开头，以便可以将其识别为 XML。

b) 最好声明您的对象设置（始终在声明头中使用Option Explicit）。由于您使用的是所谓的后期绑定，因此编写如下内容就足够了：

Dim XDoc      As Object
Dim lists     As Object
Dim listNode  As Object
Dim fieldNode As Object

提示如果您使用 Set XDoc = CreateObject("MSXML2.DOMDocument") 将 XDoc 对象设置为内存，通常您将获得较旧的版本 (3.0)，因此在大多数情况下，最好明确使用 Set XDoc = CreateObject("MSXML2.DOMDocument.6.0")，其中包括XPath 自动。如果没有，您应该按如下方式完成您的代码：

Set XDoc = CreateObject("MSXML2.DOMDocument")
XDoc.async = False: XDoc.validateOnParse = False
XDoc.setProperty "SelectionLanguage", "XPath"       ' << XPath functionality

c) 您的 XML 文件未成功加载，因为它在 P Griffiths & Sons 和 Jo & hn 中包含一个名为 & 的不可读字符，必须更改为“&”。 & 字符用作特殊字符的通用前缀，因此您不能单独包含在文件中。您可以使用以下代码测试加载，而不是简单地使用XDoc.Load (ThisWorkbook.Path & "\test.xml")：

If XDoc.Load(ThisWorkbook.Path & "\test.xml") Then
   MsgBox "Loaded successfully"
Else
  Dim xPE        As Object    ' Set xPE = CreateObject("MSXML2.IXMLDOMParseError")
  Dim strErrText As String
  Set xPE = XDoc.parseError
  With xPE
     strErrText = "Load error " & .ErrorCode & " xml file " & vbCrLf & _
     Replace(.URL, "file:///", "") & vbCrLf & vbCrLf & _
    xPE.reason & _
    "Source Text: " & .srcText & vbCrLf & vbCrLf & _
    "Line No.:    " & .Line & vbCrLf & _
    "Line Pos.: " & .linepos & vbCrLf & _
    "File Pos.:  " & .filepos & vbCrLf & vbCrLf
  End With
  MsgBox strErrText, vbExclamation
  Set xPE = Nothing
  Exit Sub
End If

d) 顺便说一句，还有其他更完整的方法可以遍历您的节点（递归调用）。当然你会在 SO 网站上找到一些。

Answer 2

您的代码对我来说运行良好。作为@FlorentB。建议，该文档可能无法解析。我怀疑他们的文件名有错误。添加一些错误处理将有助于捕获这些错误。

Sub PrintXML()

    Dim FilePath As String
    Dim XDoc As Object

    FilePath = ThisWorkbook.Path & "\test.xml"

    If Len(Dir(FilePath)) = 0 Then
        MsgBox "File not Found:" & vbCrLf & FilePath, vbCritical
        Exit Sub
    End If

    Set XDoc = CreateObject("MSXML2.DOMDocument")
    XDoc.async = False: XDoc.validateOnParse = False
    XDoc.Load ("C:\Users\norkiosk\Documents\Fax\test.xml")

    'Get Document Elements
    Set lists = XDoc.DocumentElement

    If lists Is Nothing Then
        MsgBox "Failed to Parse File:" & vbCrLf & FilePath, vbCritical
        Exit Sub
    End If

    'Traverse all elements 2 branches deep
    For Each listNode In lists.ChildNodes
        For Each fieldNode In listNode.ChildNodes
            Debug.Print "[" & fieldNode.BaseName & "] = [" & fieldNode.Text & "]"
        Next fieldNode
    Next listNode

    Set XDoc = Nothing

End Sub