VBA - отображать каждый узел и его значение из XML

У меня есть простой XML, как показано ниже, и мне нужно отображать имя каждого узла и его значение. Ни у одного элемента не будет атрибута.

<?xml version="1.0" encoding="UTF-8"?>
<ResponseEnvelope xmlns="http://www.nwabcdfdfd.com/messagin" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance">
   <ResponseHeader>
      <RequestId>directv_99e0857d-abf3-461c-913e-3ab59c6b5ef6</RequestId>
      <ResponseId>1162969</ResponseId>
      <MessageVersion>1.10</MessageVersion>
      <RequestTimestamp>2013-02-12T17:26:28.172Z</RequestTimestamp>
      <ResponseTimestamp>2013-02-12T17:26:50.409Z</ResponseTimestamp>
      <SenderId>CarePortal2</SenderId>
      <ProgramName />
      <TestProdFlag>P</TestProdFlag>
      <ResultCode>9</ResultCode>
      <Locale>en_US</Locale>
      <Errors>
         <Error>
            <ErrorCode>9</ErrorCode>
            <ErrorNumber>90001</ErrorNumber>
            <ErrorMessage>System error occurred</ErrorMessage>
            <ErrorFieldId />
         </Error>
      </Errors>
   </ResponseHeader>
   <ResponseBody xsi:type="CPSingleSignOnResponse">
      <PortalUserID>45497</PortalUserID>
      <PartyID>1858186</PartyID>
      <WarrantyItemName>DTV ABC WOLE HE P</WarrantyItemName>
      <WarrantyInventoryItemId>138677</WarrantyInventoryItemId>
      <ClientWarrantySku>202</ClientWarrantySku>
      <ClientWarrantyDescription>DV Plan</ClientWarrantyDescription>
      <ContractNumber>4003564</ContractNumber>
      <IsPortalUserCreated>N</IsPortalUserCreated>
      <IsPartyCreated>N</IsPartyCreated>
      <IsContractUpdated>N</IsContractUpdated>
      <IsFootPrintUpdated>N</IsFootPrintUpdated>
      <Customer>
         <PartyId>185812386</PartyId>
         <Salutation />
         <FirstName>Tejas</FirstName>
         <LastName>Tanna</LastName>
         <AddressList>
            <Address>
               <PartySiteId>3617490</PartySiteId>
               <Type>BILTO</Type>
               <Address1>CASCADES</Address1>
               <Address2>202</Address2>
               <Address3>RIDGE HEAVEN</Address3>
               <Address4 />
               <City>STERLING</City>
               <State>VA</State>
               <PostalCode>20165</PostalCode>
               <County>LOUDOUN</County>
               <Province />
               <Country>US</Country>
               <Urbanization />
               <AddressStyle>US</AddressStyle>
            </Address>
            <Address>
               <PartySiteId>3613791</PartySiteId>
               <Type>SHIP_T</Type>
               <Address1>CASADS</Address1>
               <Address2>22</Address2>
               <Address3>RIE HEEN</Address3>
               <Address4 />
               <City>STELI</City>
               <State>VA</State>
               <PostalCode>2065</PostalCode>
               <County>LOUUN</County>
               <Province />
               <Country>US</Country>
               <Urbanization />
               <AddressStyle>US</AddressStyle>
            </Address>
         </AddressList>
         <PhoneList>
            <Phone>
               <ContactPointId>2371717</ContactPointId>
               <Type>HOME PNE</Type>
               <PhoneNumber>51-62-7464</PhoneNumber>
               <Country>1</Country>
               <PrimaryFlag>Y</PrimaryFlag>
            </Phone>
         </PhoneList>
         <EmailList>
            <Email>
               <ContactPointId>237516</ContactPointId>
               <EmailAddress>[email protected]</EmailAddress>
               <PrimaryFlag>Y</PrimaryFlag>
            </Email>
         </EmailList>
      </Customer>
   </ResponseBody>
</ResponseEnvelope>

Единственная проблема здесь заключается в том, что может быть какой-то элемент, который может иметь собственный подэлемент, например. Адрес Таким образом, код должен иметь рекурсивную функцию.

Также не должны отображаться элементы, которые не имеют текста, такого как Address4 (у него есть только подэлементы). Также не должны отображаться такие элементы, как Провинция.

Я пробовал следующий код, но не работал.

Sub Driver()
    Range("4:" & Rows.Count).ClearContents
    Set xmlDoc = CreateObject("Microsoft.XMLDOM")

    i = 4
    xmlDoc.LoadXML (Range("A2"))
    Set oParentNode = xmlDoc.DocumentElement.SelectNodes("ResponseBody")(0)
    Call List_ChildNodes(oParentNode, i, "A", "B")
End Sub

Sub List_ChildNodes(oParentNode, i, NameColumn, ValueColumn)
    For Each oChildNode In oParentNode.ChildNodes
        If oChildNode.ChildNodes.Length > 1 Then
            Call List_ChildNodes(oChildNode, i, NameColumn, ValueColumn)
        Else
            Cells(i, NameColumn) = oChildNode.tagname
            Cells(i, ValueColumn) = oChildNode.Text
            i = i + 1
        End If
    Next
End Sub

xml recursion excel vba xmldom
person Tejas    schedule 14.02.2013    source источник
comment
это не работает - какую ошибку вы получаете? Что вы ожидаете на выходе и что видите?   -  person Floris    schedule 14.02.2013
comment
@Tejas, вы думали об использовании Xpath для извлечения всех элементов в узле, а затем просто просматриваете NodeList и получаете нужную информацию?   -  person CaBieberach    schedule 14.02.2013
comment
@Floris: здесь должно быть два окна сообщений. Первый должен сказать: «Адрес: здесь идет адрес», а второй должен сказать «Дом: 123». (Согласно обновленному мной XML). Не могли бы вы помочь в этом?   -  person Tejas    schedule 14.02.2013
comment
@CaBieberach: Использование Xpath, когда я говорю Set All_nodes = xmlDoc.SelectNodes(//*), также возвращает узлы Contact и PhoneList, которые мне не нужны, потому что они не нет никакого текста. У них просто есть подэлементы. Любое обходное решение, пожалуйста?   -  person Tejas    schedule 14.02.2013
comment
Microsoft.XMLDOM почти наверняка неверно. Вместо этого попробуйте MSXML2.DOMDocument60   -  person barrowc    schedule 15.02.2013
comment
Различные узлы, такие как Address4 и провинция в примере данных, не имеют текстового содержимого. Должны ли они быть возвращены или нет?   -  person barrowc    schedule 15.02.2013
comment
@barrowc: должен отображаться только узел с текстом. Так что Address4 не должно быть. Ваша помощь будет высоко оценена, так как мне это нужно в срочном порядке. Спасибо.   -  person Tejas    schedule 15.02.2013

Ответы (3)


arrow_upward
5
arrow_downward

Предполагая, что ваш XML находится в ячейке «A2», первая проблема заключается в том, что ваша строка

  Set oParentNode = xmlDoc.DocumentElement.SelectNodes("ResponseBody")(0)

Возвращает nothing. Измените его на

  Set oParentNode = xmlDoc.DocumentElement

и в коде хоть будет что обрабатывать.

РЕДАКТИРОВАТЬ 1 и 2

Другая проблема заключается в том, что узел внутри узла не даст правильного результата. Чтобы решить эту проблему, вам нужно немного изменить функцию List_ChildNodes. Первая модификация работала для приведенных вами примеров, но не для более позднего, который неправильно анализируется с помощью кода, который я предоставил ранее. Поэтому я добавил ловушку ошибок, которая гарантирует, что даже этот XML будет прочитан (как я считаю) правильно. Трюк с использованием On Error Resume Next, по сути, является эквивалентом VBA оператора Try ... Catch (за исключением того, что «уловка» заключается в следующем: «установите L в ноль, если есть ошибка. Мы фактически сначала устанавливаем L в ноль, и не перезаписываем это на ошибка. То же самое, но в другом порядке. Один из тех трюков, которым не учат в школе!)

Sub List_ChildNodes(oParentNode, i, NameColumn, ValueColumn)
Dim L As Integer
    For Each oChildNode In oParentNode.ChildNodes
        L = 0
        Err.Clear
        On Error Resume Next
        L = oChildNode.ChildNodes(0).ChildNodes.Length
        If L > 0 Then
            Call List_ChildNodes(oChildNode, i, NameColumn, ValueColumn)
        Else
            If Not oChildNode.Text = "" Then
                Cells(i, NameColumn) = oChildNode.tagName
                Cells(i, ValueColumn) = oChildNode.Text
                i = i + 1
            End If
        End If
    Next
End Sub

Я протестировал последнюю версию с большим фрагментом XML, который вы предоставили, и оказалось, что он анализируется без сбоев. Я не собирался проходить его построчно, чтобы проверить...

person Floris    schedule 14.02.2013
comment
Спасибо за ответ. Но согласно обновленному XML он не отображает Home: 123 Это проблема, с которой я столкнулся. Можете ли вы найти обходной путь для того же? - person Tejas; 14.02.2013
comment
Я наблюдал то же самое, что и вы. Я внес правку в код - теперь он у меня работает. Пожалуйста, подтвердите, если это решит проблему для вас. - person Floris; 15.02.2013
comment
Спасибо, но все же это не идеально. См. обновленный XML. Я добавил в него Dummy самозакрывающийся узел. Код не работает нормально на нем. - person Tejas; 15.02.2013
comment
Я дважды ответил на ваш вопрос, а затем вы меняете проблему ... Можете еще раз взглянуть утром, но на самом деле это не так. - person Floris; 15.02.2013
comment
Очень жаль. Я обновил окончательный XML сейчас. Дальше изменений не будет. Не могли бы вы помочь мне прочитать все подузлы узла RequestBody? Я очень ценю вашу помощь до сих пор. Я нашел java2s.com/Code/Php/XML/ полезным, но теперь в состоянии использовать его правильно. - person Tejas; 15.02.2013

arrow_upward
0
arrow_downward

В Excel есть встроенный импортер .xml. Вам не нужно писать свой собственный (если вы не пытаетесь сделать что-то необычное). http://office.microsoft.com/en-us/excel-help/import-xml-data-HP010206405.aspx#BMimport_an_xml_file_as_an_xml_list_wit

person Stepan1010    schedule 14.02.2013

arrow_upward
0
arrow_downward

Попробуйте эту версию.

Заметки:

  • использует MSXML2.DOMDocument.6.0, а не очень устаревший Microsoft.XMLDOM
  • использует Option Explicit, и все переменные объявляются с соответствующим типом
  • загружается из файла для моего удобства, но вы, очевидно, можете изменить его обратно, чтобы читать из диапазона
  • позволяет избежать обычной проблемы с пространством имен XPath по умолчанию в MSXML2, объявляя префикс для пространства имен по умолчанию и используя этот префикс в любых запросах XPath
  • сделать текстовые узлы ответственными за печать собственного текста
  • используйте функцию, а не подпрограмму, чтобы мы знали, когда распечатать имя узла

Вот код:

Option Explicit

Sub Driver()

Dim i As Long
Dim xmlDoc As Object
Dim oParentNode As Object
Dim bDiscard As Boolean

Range("4:" & Rows.Count).ClearContents
i = 4

Set xmlDoc = CreateObject("MSXML2.DOMDocument.6.0")
xmlDoc.Load "foo.xml"
xmlDoc.setProperty "SelectionNamespaces", "xmlns:r='http://www.nwabcdfdfd.com/messagin'"

Set oParentNode = xmlDoc.selectSingleNode("//r:ResponseBody")
bDiscard = listChildNodes(oParentNode, i, "A", "B")

End Sub

Function listChildNodes(oParentNode As Object, i As Long, NameColumn As String, ValueColumn As String) As Boolean

Dim oChildNode As Object
Dim bResult As Boolean

If (oParentNode.nodeType = 3) Then 'i.e. DOMNodeType.NODE_TEXT
    Cells(i, ValueColumn).Value = oParentNode.Text
    listChildNodes = True
Else
    For Each oChildNode In oParentNode.childNodes
        bResult = listChildNodes(oChildNode, i, NameColumn, ValueColumn)

        If (bResult) Then
            Cells(i, NameColumn).Value = oParentNode.nodeName
            i = i + 1
        End If
    Next oChildNode
    listChildNodes = False
End If

End Function
person barrowc    schedule 16.02.2013