如何将 excel 连接到 Microsoft 的 QnA Maker (VBA)

How to connect excel to microsoft's QnA Maker (VBA)

我定期收到 excel 个问题文件(我有以前迭代的答案。问题总是相似的),我想自动回复。我在 Microsoft 的 QnAMaker 中创建了一个包含所有 question/answer 对的知识库。

如何调用 Microsoft 的 QnAMaker 来回答我来自 excel 的问题。我一直在寻找 vba 个示例,但到目前为止我还没有找到任何东西。 我相信我需要使用 vba 从 excel 授权发出 HTTP 请求,然后处理响应。 有人知道我如何提出请求并处理它吗?

感谢任何帮助。谢谢!

这些是 QnAMaker 提供的用于调用的示例详细信息:

 POST /knowledgebases/d02d1d7e-1bc0-461a-8074-37749cae41b9/generateAnswer
 Host: https://rfp1.azurewebsites.net/qnamaker
 Authorization: EndpointKey cec4b630-9e77-474f-8df4-e6430a5678c8
 Content-Type: application/json
 {"question":"<Your question>"}

我找到了两种方法。首先是 VBA。其次是 Power Queries。

VBA

可选设置

  1. 通过转到“文件”>“选项”>“自定义功能区”>“检查开发人员”,将“开发人员”选项卡添加到功能区

  2. 转到开发人员选项卡,然后插入 > 按钮

  3. 为宏命名 "GetReplies"

  4. 点击新建

备注:

VBA 设置

  1. 在“开发人员”选项卡中,单击“Visual Basic”按钮(如果它没有自动打开)

  2. 转到“工具”>“参考”并启用以下库:

  3. 导入this JSON library following the installation instructions

  4. Copy/paste这个:

VBA代码:

Sub GetReplies()

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

        questionWorksheetName = "Sheet1"
        questionsColumn = "A"
        firstQuestionRow = "2"

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

    'Non-User Settings
    Dim questionWorksheet As Worksheet
        Set questionWorksheet = Sheets(questionWorksheetName)
    Dim startCell As String
        startCell = questionsColumn & firstQuestionRow
    Dim questionsRange As Range
        Set questionsRange = questionWorksheet.Range(startCell, questionWorksheet.Range(startCell).End(xlDown))

    'Loop through all non-blank cells
    Dim answer As String
    For Each cell In questionsRange
        If Not IsEmpty(cell) Then
            answer = GetAnswer(cell.Value, kbHost, kbId, endpointKey)
            'Add answer to cell
            cell.Offset(0, 1).Value = answer
        End If
    Next

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 Dictionary
    Set json = JsonConverter.ParseJson(xmlhttp.ResponseText)

    Dim answer As Dictionary

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

End Function
  1. 适当编辑顶部的"User Settings"

在运行之后,我得到:

幂查询

创建 HTTP 连接查询

  1. 数据选项卡 > 获取数据 > 从其他来源 > 空白查询

  2. 单击“高级编辑器”并复制粘贴

代码:

(Question as text) =>
let
    url = "https://***host****.azurewebsites.net/qnamaker/knowledgebases/****kbId******/generateAnswer",
    endpointKey = "****endpointKey*****",
    table = Excel.CurrentWorkbook(){[Name="Answers"]}[Content],
    row = Table.SelectRows(table, each ([Answer] = Question)),
    body = "{""question"":""" & Question & """}",
    Parsed_JSON = Json.Document(body),
    BuildQueryString = Uri.BuildQueryString(Parsed_JSON),
    headers = [#"Content-Type"="application/json", #"Authorization"="EndpointKey " & endpointKey],
    content = Text.ToBinary(body),
    Source = Json.Document(Web.Contents(url, [Headers = headers, Content = content])),
    answers = Source[answers],
    answers1 = answers{0},
    answer = answers1[answer]
in
    answer
  1. 根据需要替换变量

  2. 将查询重命名为 "GetAnswer"

  3. 退出 Power Query,保存更改

创建 Table

  1. 创建一个 table 并提出您的问题

  1. Select table。 Table 设计选项卡 > 将 table 重命名为 Answers

  2. 选中整个 table,数据选项卡 > 来自 Table/Range

  3. 添加列 > 调用自定义函数

  4. 列名 = Answers,函数查询 = GetAnswer,问题:ColumnName = Question

  5. 好的。 Ok/Exit/Save

然后您可以将问题添加到 table,转到创建 Question/Answer table 的 sheet,然后单击刷新以获得新答案。