Yahoo!Japanのテキスト解析APIを使ってみた

Yahoo!Japan デベロッパーネットワークトップ > テキスト解析 > キーフレーズ抽出
https://developer.yahoo.co.jp/webapi/jlp/keyphrase/v1/extract.html

Const APIKEY_Y As String = "取得したAPIキー"
Public Function getKeyWords(ByVal str As String) As String
  Dim sUrl As String: sUrl = "https://jlp.yahooapis.jp/KeyphraseService/V1/extract"
  Dim sSendData As String: sSendData = "appid=" & APIKEY_Y & "&sentence=" & str
  Dim objHttp As XMLHTTP: Set objHttp = New XMLHTTP
  Dim objResponse As DOMDocument
  Dim sRet As String: sRet = ""
  Dim el As IXMLDOMNode
  
  objHttp.Open "POST", sUrl, False
  Call objHttp.setRequestHeader("Content-Type", "application/x-www-form-urlencoded")
  objHttp.send (sSendData)
  Set objResponse = objHttp.responseXML
  
  'エラーが返ってきた場合はエラーメッセージを返す
  If objResponse.SelectNodes("/Error").Length > 0 Then
    For Each el In objResponse.SelectNodes("/Error")
      If sRet <> "" Then sRet = sRet & vbCrLf
      sRet = sRet & el.Text
    Next el
    getKeyWords = sRet
    Exit Function
  End If
  
  For Each el In objResponse.SelectNodes("/ResultSet/Result")
    If sRet <> "" Then sRet = sRet & vbCrLf
    sRet = sRet & el.FirstChild.Text & vbTab & el.LastChild.Text
  Next el
  getKeyWords = sRet
  
End Function

校正支援 https://developer.yahoo.co.jp/webapi/jlp/kousei/v1/kousei.html

Public Function getKousei(ByVal str As String)
  Dim sUrl As String: sUrl = "  https://jlp.yahooapis.jp/KouseiService/V1/kousei"
  Dim sSendData As String: sSendData = "appid=" & APIKEY_Y & "&sentence=" & str
  Dim objHttp As XMLHTTP: Set objHttp = New XMLHTTP
  Dim objResponse As DOMDocument
  Dim sRet As String: sRet = ""
  Dim el As IXMLDOMNode
  
  objHttp.Open "POST", sUrl, False
  Call objHttp.setRequestHeader("Content-Type", "application/x-www-form-urlencoded")
  objHttp.send (sSendData)
  Set objResponse = objHttp.responseXML
  
  'エラーが返ってきた場合はエラーメッセージを返す
  If objResponse.SelectNodes("/Error").Length > 0 Then
    For Each el In objResponse.SelectNodes("/Error")
      If sRet <> "" Then sRet = sRet & vbCrLf
      sRet = sRet & el.Text
    Next el
    getKousei sRet
    Exit Function
  End If
  For Each el In objResponse.SelectNodes("/ResultSet/Result")
'    Stop
    If sRet <> "" Then sRet = sRet & vbCrLf
    For i = 0 To el.ChildNodes.Length - 1
      sRet = sRet & el.ChildNodes(i).Text & vbTab
    Next i
    sRet = Left(sRet, Len(sRet) - 1)
  Next el
  getKousei = sRet
End Function