使用VBA从XML文件提取元素

时间:2018-10-02 20:04:06

标签: excel xml vba excel-vba

我目前正在尝试构造一个函数,该函数使用VBA从Excel文件中自动搜索同义词。我能够从API检索XML文件。但是,我无法提取同义词(标记为“ term”)。如何从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>

2 个答案:

答案 0 :(得分:0)

在这里,您可以从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

答案 1 :(得分:0)

这将获取属性项值

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