Извлечение элементов из файла XML с использованием VBA

Question

В настоящее время я пытаюсь создать функцию, которая автоматически ищет синонимы из файла Excel с использованием VBA.Мне удалось получить XML-файл из API.Тем не менее, я не смог извлечь синонимы (помечены как «термин»).Как я могу извлечь синонимы из файла XML?

это мой текущий код:

Option Explicit

Sub get_synonym()
   Dim XMLReq As New MSXML2.XMLHTTP60
   Dim ant_wort As String

   wort = InputBox("What word would you like to get checked?")

   'function'
   XMLReq.Open "GET", "https://www.openthesaurus.de/synonyme/search?q=" & wort & "&format=text/xml", False
   XMLReq.send
   If XMLReq.Status <> 200 Then
       MsgBox ("Problem" & vbNewLine & XMLReq.Status & " - " & XMLReq.statusText)
       Exit Sub
   End If

   ant_wort = XMLReq.responseText
   Debug.Print ant_wort
   ' ### I would like to fill an array with the synonyms at this point'
End Sub

the xml looks like this:
<matches><metaData><apiVersion content='0.1.3'/><warning content='WARNING -- this XML format may be extended without warning'/><copyright content='Copyright (C) 2017 Daniel Naber (www.danielnaber.de)'/><license content='Creative Commons Attribution-ShareAlike 4.0 or GNU LESSER GENERAL PUBLIC LICENSE Version 2.1'/><source content='http://www.openthesaurus.de'/><date content='Tue Oct 02 19:08:27 CEST 2018'/></metaData><synset id='29979'><categories><category name='Linguistik/Sprache'/></categories><term term='morphologisches Wort'/><term term='Wort'/></synset><synset id='35385'><categories><term term='Wort'/></synset></matches>

Answer 1

Получает значения термина атрибута

Option Explicit
Public Sub get_synonym()

    Dim wort As String
    wort = "anklagen"
    'wort = InputBox("What word would you like to get checked?")

    Dim xmlDoc   As MSXML2.DOMDocument60
    Set xmlDoc = New MSXML2.DOMDocument60
    xmlDoc.async = False
    xmlDoc.validateOnParse = True

    xmlDoc.Load "https://www.openthesaurus.de/synonyme/search?q=" & wort & "&format=text/xml"
    If xmlDoc.parseError.ErrorCode <> 0 Then
        MsgBox "Error was " + xmlDoc.parseError.reason
    End If

    Dim nodes As Object, node As Object
    Set nodes = xmlDoc.SelectNodes("//term")
    For Each node In nodes
        Debug.Print node.Attributes.getNamedItem("term").Text
    Next

End Sub

Answer 2

Вот как вы можете извлечь информацию из XML-ответа.Отсюда вы можете перенести данные ответа в ячейки или диапазон или по вашему выбору.Ключ заключается в том, чтобы перейти к XML-ответу и получить доступ к атрибутам для тега, который вы ищете.

(жестко запрограммированный ввод использует слово, известное как ответ со списком синонимов.)

Option Explicit

Sub get_synonym()
    Dim XMLReq As New MSXML2.XMLHTTP60
    Dim wort As String
    Dim ant_wort As String

    wort = "beginnen"
    'wort = InputBox("What word would you like to get checked?")

    'function'
    XMLReq.Open "GET", "https://www.openthesaurus.de/synonyme/search?q=" & wort & "&format=text/xml", False
    XMLReq.send
    If XMLReq.Status <> 200 Then
        MsgBox ("Problem" & vbNewLine & XMLReq.Status & " - " & XMLReq.statusText)
        Exit Sub
    End If

    Dim xmlNode As MSXML2.IXMLDOMNode
    For Each xmlNode In XMLReq.responseXML.SelectNodes("//matches/synset/term")
        Debug.Print xmlNode.Attributes(0).nodeTypedValue
    Next xmlNode
    Debug.Print "done."
End Sub