Watson NLC を Excel 関数として呼ぶ

Watson NLC をExcel関数として呼ぶ機能を実装してみました。

ソースコード

'# http://javascript.dohow.jp/advance/jsonvba.shtml
'# http://blog.goo.ne.jp/xmldtp/e/c7e3c3631d31206f818b30276d0f3091


Function WatsonNLCJSON(inputtext As String, nlc_user As String, nlc_password As String, classifierID As String)

    If inputtext = "" Then
        WatsonNLCJSON = ""
        Exit Function
    End If

    If nlc_user = "" Then
        WatsonNLCJSON = "EMPTY: nlc_user"
        Exit Function
    End If
    If nlc_password = "" Then
        WatsonNLCJSON = "EMPTY: nlc_password"
        Exit Function
    End If
    If classifierID = "" Then
        WatsonNLCJSON = "EMPTY: classifierID"
        Exit Function
    End If


    Dim urlWatsonNLC As String 'For Watson NLC

    urlWatsonNLC = "https://gateway.watsonplatform.net/natural-language-classifier/api/v1"

    target_url = urlWatsonNLC & "/classifiers/" & classifierID & "/classify"

    ' 注意:エンコードはしてません．
    senddata = "{""text"":""" & inputtext & """}}"

    Set httpObj = CreateObject("MSXML2.XMLHTTP")

    httpObj.Open "POST", target_url, False, nlc_user, nlc_password

    Call httpObj.setRequestHeader("Content-Type", "application/json; charset=utf-8")

    httpObj.send (senddata)

    Debug.Print "Status: " & httpObj.Status


    Dim strJSON As String 'JSONデータ(文字列)

    strJSON = httpObj.ResponseText

    WatsonNLCJSON = strJSON


End Function



Function WatsonNLC(inputtext As String, nlc_user As String, nlc_password As String, classifierID As String)

    If inputtext = "" Then
        WatsonNLC = ""
        Exit Function
    End If

    If nlc_user = "" Then
        WatsonNLC = "EMPTY: nlc_user"
        Exit Function
    End If
    If nlc_password = "" Then
        WatsonNLC = "EMPTY: nlc_password"
        Exit Function
    End If
    If classifierID = "" Then
        WatsonNLC = "EMPTY: classifierID"
        Exit Function
    End If


    Dim objSC As Object 'Script Control
    Dim strFunc As String '関数文字列
    Dim strJSON As String 'JSONデータ(文字列)
    Dim objJSON As Object 'JSONファイルをパースしたもの


    Set objSC = CreateObject("ScriptControl")
        objSC.Language = "JScript"
        strFunc = "function jsonParse(s) { return eval('(' + s + ')'); }"
        objSC.AddCode strFunc


    strJSON = WatsonNLCJSON(inputtext, nlc_user, nlc_password, classifierID)

    Debug.Print "JSON: " & strJSON

    Set objJSON = objSC.CodeObject.jsonParse(strJSON)

    Debug.Print inputtext
    Debug.Print "-> " & objJSON.top_class

    ' RETURN VALUE
    WatsonNLC = objJSON.top_class


'    '# 後はお好きにどうぞ．．
'
'    i = 1
'
'    For Each rec In objJSON.classes
'
'        ' RETURN VALUE
'        WatsonNLC = rec.class_name
'
'        If i = 1 Then
'            Exit For
'        End If
'
'        i = i + 1
'
'    Next


' JSON レスポンスのサンプル
'{
'  "classifier_id" : "xxx",
'  "url" : "https://gateway.watsonplatform.net/natural-language-classifier/api/v1/classifiers/xxx",
'  "text" : "文書を分類したい．",
'  "top_class" : "nlc",
'  "classes" : [ {
'    "class_name" : "nlc",
'    "confidence" : 0.9107145996247646
'  }, {
'    "class_name" : "document_conversion",
'    "confidence" : 0.035915835602894575
'  }, {
'    "class_name" : "alchemy_vision",
'    "confidence" : 0.02516578297472003
'  }, {
'    "class_name" : "r_and_r",
'    "confidence" : 0.010416838465519388
'  }, {
'    "class_name" : "dialog",
'    "confidence" : 0.008664807440404784
'  }, {
'    "class_name" : "text_to_speech",
'    "confidence" : 0.004777489683843767
'  }, {
'    "class_name" : "speech_to_text",
'    "confidence" : 0.0043446462078528345
'  } ]
'}

End Function

Function test()

    Dim s As String

    s = WatsonNLC("テスト", "a6ab6e2a-18b0-4486-a65b-069792117b59", "IWACaWUe9Gxp", "be05f9x94-nlc-63")

    Debug.Print s

End Function

Function test1()

    Dim objSC As Object 'Script Control
    Dim s As Object
    Dim strFunc As String '関数文字列

    Set objSC = CreateObject("ScriptControl")
        objSC.Language = "JScript"
        strFunc = "function encode(s) { return encodeURI(' + s + '); }"
        objSC.AddCode strFunc

    Debug.Print objSC.CodeObject.encodeURI("テスト")

End Function

Function test2()
    Dim objSC As Object 'Script Control
    Dim s As String
    Dim strFunc As String '関数文字列

    Set objSC = CreateObject("ScriptControl")
        objSC.Language = "JScript"
        strFunc = "function encode(s) { return encodeURI(' + s + '); }"
        objSC.AddCode strFunc

   s = objSC.CodeObject.encodeURI("テスト")
    Debug.Print s

End Function