如何将MS Word连接到Microsoft的QnA Maker(VBA) [英] How to connect MS Word to microsoft's QnA Maker (VBA)

问题描述

我正在尝试使用VBA将MS Word连接到Microsoft的QnAMaker，以帮助回答我收到的各种类似问题. 我的想法是选择问题，然后让vba查询答案并将其复制到剪贴板(答复模板不同，这样我可以选择将答案输出到何处).

I am trying to connect MS Word to Microsoft's QnAMaker using VBA to help answer a wide variety of similar questions I receive. My idea is select the question and then have vba query the answer and copy it to the clipboard (templates for replies are different, this way I can select where to output the answer).

感谢您的帮助.谢谢.

(我正在使用此JSON库: https://github.com/VBA-tools /VBA-JSON )

(I am using this JSON library: https://github.com/VBA-tools/VBA-JSON)

我已经应用了以下问题部分中所述的建议解决方案: https ://github.com/VBA-tools/VBA-JSON/issues/68

I have already applied the suggested solutions described in the issue section below: https://github.com/VBA-tools/VBA-JSON/issues/68

Sub copyAnswer()

'User Settings
Dim questionWorksheetName As String, questionsColumn As String, 
firstQuestionRow As String, kbHost As String, kbId As String, endpointKey 
As String
Dim str As String

str = Selection.Text

    kbHost = "https://rfp1.azurewebsites.net/********"
    kbId = "********-********-*********"
    endpointKey = "********-********-********"

'Loop through all non-blank cells
Dim answer, score As String
Dim myArray() As String
Dim obj As New DataObject

        answer = GetAnswer(str, kbHost, kbId, endpointKey)

        Call ClipBoard_SetData(answer)
End Sub

Function GetAnswer(question, kbHost, kbId, endpointKey) As String
'HTTP Request Settings
Dim qnaUrl As String
    qnaUrl = kbHost & "/knowledgebases/" & kbId & "/generateAnswer"
Dim contentType As String
    contentType = "application/json"
Dim data As String
    data = "{""question"":""" & question & """}"

'Send Request
Dim xmlhttp As New MSXML2.XMLHTTP60

xmlhttp.Open "POST", qnaUrl, False
    xmlhttp.setRequestHeader "Content-Type", contentType
    xmlhttp.setRequestHeader "Authorization", "EndpointKey " & endpointKey
**xmlhttp.send data**

'Convert response to JSON
Dim json As Scripting.Dictionary

Set json = JsonConverter.ParseJson(xmlhttp.responseText)

Dim answer As Scripting.Dictionary

For Each answer In json("answers")
'Return response
    GetAnswer = answer("answer")
Next

End Function

Private Function json_ParseObject(json_String As String, ByRef json_Index As Long) As Scripting.Dictionary
Dim json_Key As String
Dim json_NextChar As String

Set json_ParseObject = New Scripting.Dictionary
json_SkipSpaces json_String, json_Index

...

我遇到以下错误，不确定如何解决:调用send方法后无法调用此方法".

I am encountering the following error which I am uncertain how to resolve: "This method cannot be called after the send method has been called".

该错误发生在以下行:xmlhttp.send数据

The error occurs on the line: xmlhttp.send data

推荐答案

您链接的GitHub问题有点答案，但还不完整.这是您要执行的操作(从Word中的VBA开发控制台):

The GitHub issue you linked kind of had the answer, but it's not complete. Here's what you do (from the VBA Dev Console in Word):

在模块中> JsonConverter

In Modules > JsonConverter

转到Private Function json_ParseObject

在两个地方将Scripting.添加到Dictionary:

来自:

Private Function json_ParseObject(json_String As String, ByRef json_Index As Long) As Dictionary

收件人:

Private Function json_ParseObject(json_String As String, ByRef json_Index As Long) As Scripting.Dictionary

和来自:

Set json_ParseObject = New Dictionary

收件人:

Set json_ParseObject = New Scripting.Dictionary

在GetAnswer()中:

也从以下位置更改:

Dim json As Dictionary

收件人:

Dim json As Scripting.Dictionary

和来自:

Dim answer As Dictionary

收件人:

Dim answer As Scripting.Dictionary

这是我完整的工作代码:

在ThisDocument中:

Sub copyAnswer()

'User Settings
Dim kbHost As String, kbId As String, endpointKey As String
Dim str As String

str = "test"

    kbHost = "https:/*********.azurewebsites.net/qnamaker"
    kbId = "***************************"
    endpointKey = "*************************"

'Loop through all non-blank cells
Dim answer, score As String
Dim myArray() As String
    answer = GetAnswer(str, kbHost, kbId, endpointKey)
End Sub

Function GetAnswer(question, kbHost, kbId, endpointKey) As String
    'HTTP Request Settings
    Dim qnaUrl As String
        qnaUrl = kbHost & "/knowledgebases/" & kbId & "/generateAnswer"
    Dim contentType As String
        contentType = "application/json"
    Dim data As String
        data = "{""question"":""" & question & """}"

    'Send Request
    Dim xmlhttp As New MSXML2.XMLHTTP60

    xmlhttp.Open "POST", qnaUrl, False
        xmlhttp.setRequestHeader "Content-Type", contentType
        xmlhttp.setRequestHeader "Authorization", "EndpointKey " & endpointKey
    xmlhttp.send data

    'Convert response to JSON
    Dim json As Scripting.Dictionary
    Set json = JsonConverter.ParseJson(xmlhttp.responseText)

    Dim answer As Scripting.Dictionary

    For Each answer In json("answers")
    'Return response
        GetAnswer = answer("answer")
    Next

End Function

在模块中> JsonConverter

Private Function json_ParseObject(json_String As String, ByRef json_Index As Long) As Scripting.Dictionary
    Dim json_Key As String
    Dim json_NextChar As String

    Set json_ParseObject = New Scripting.Dictionary
    json_SkipSpaces json_String, json_Index
    If VBA.Mid$(json_String, json_Index, 1) <> "{" Then
        Err.Raise 10001, "JSONConverter", json_ParseErrorMessage(json_String, json_Index, "Expecting '{'")
    Else
        json_Index = json_Index + 1

        Do
            json_SkipSpaces json_String, json_Index
            If VBA.Mid$(json_String, json_Index, 1) = "}" Then
                json_Index = json_Index + 1
                Exit Function
            ElseIf VBA.Mid$(json_String, json_Index, 1) = "," Then
                json_Index = json_Index + 1
                json_SkipSpaces json_String, json_Index
            End If

            json_Key = json_ParseKey(json_String, json_Index)
            json_NextChar = json_Peek(json_String, json_Index)
            If json_NextChar = "[" Or json_NextChar = "{" Then
                Set json_ParseObject.Item(json_Key) = json_ParseValue(json_String, json_Index)
            Else
                json_ParseObject.Item(json_Key) = json_ParseValue(json_String, json_Index)
            End If
        Loop
    End If
End Function

这篇关于如何将MS Word连接到Microsoft的QnA Maker(VBA)的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！