如何将excel连接到microsoft的QnA Maker（VBA）

我定期收到带有问题的excel文件，我从以前的迭代中得到了答案。问题总是相似的，我想自动回复。我已经在MicrosoftsQNamaker中创建了一个知识库，里面有所有的问题/答案对

我如何打电话给Microsofts 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。第二个是权力质疑

VBA 可选设置 进入“文件>选项>自定义功能区>检查开发人员”，将“开发人员”选项卡添加到功能区

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

将宏命名为GetReplies

单击“新建”

注:

我的QnAKB主要基于。 VBA设置 如果Visual Basic按钮没有自动打开，请在“开发人员”选项卡中单击该按钮

转到工具>参考并启用以下库：

导入以下内容

复制/粘贴此文件：

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

适当地编辑顶部的用户设置 跑步后，我得到：

电力查询 创建HTTP连接查询 数据选项卡>获取数据>来自其他源>空白查询

单击高级编辑器并复制粘贴

代码：

必要时替换变量

将查询重命名为GetAnswer

退出电源查询，保存更改

创建表 用你的问题创建一个表格 选择表格。“表格设计”选项卡>将表格重命名为“答案”

选择整个表格后，数据选项卡>表格/范围

添加列>调用自定义函数

列名=答案，函数查询=GetAnswer，问题：ColumnName=问题

嗯。确定/退出/保存

---

然后，您可以将问题添加到表中，转到创建问题/答案表的工作表，然后单击“刷新”以获得新答案。

非常感谢！这非常有效：您是否知道查询是否也可以返回信心？理想情况下，如果答案可信度较低，我会知道哪些答案需要详细检查。再次感谢！你当然可以。代码的末尾是GetAnswer=answeranswer行。如果您将其更改为GetAnswer=answerscore，您将获得信心级别/分数，而不是实际答案。就个人而言，我会使用GetAnswer=answer，然后在GetReplies中使用cell.Offset0，1.Value=answeranswer和cell.Offset0，2.Value=answerscore。您可能需要更改GetAnswer上的返回类型。如果您需要帮助，请告诉我。您好，我也尝试过将您的解决方案改编为word文档，但我正在努力。我试图向GetAnswer方法提供一个问题，即word中选择的文本，但在这一行出现以下错误：对于jsonanswers中的每个答案，编译错误：参数数量错误或属性赋值无效。我认为这与返回对象的数量有关？我尝试使用所附的解决方案，但您已经实现了建议的解决方案，因此我有点不知所措。你有什么想法吗？看见要修复：1打开工具>引用并将Microsoft脚本运行时移动到Microsoft Word 16.0对象库之上。2在VBA代码中，将As Dictionary更改为As Scripting.Dictionary供您参考。我已经实现了建议的修复，我相信它已经解决了，但是错误转移到代码的另一部分。在函数GetAnswer-xmlhttp send data line中，我得到一个错误，指出：在调用send方法后无法调用此方法。这是我看到的唯一“send”方法。你有什么想法吗？

(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