简体   繁体   中英

Extracting elements from XML file using VBA

I am currently trying to construct a function that automatically searches for synonyms from an Excel file using VBA. I was able to retrieve an XML file from an API. However, I was not able to extract the synonyms (tagged with "term"). How can I extract the synonyms from the XML file?

this is my current code:

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>

Here's how you can extract information from the XML response. From here, you can drop the response data into cells or a range or your choice. The key is to step into your response XML and access the attributes for the tag you're searching.

(The hard-coded input uses a word known to respond with a synonym list.)

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

This gets attribute term values

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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM