如何使用VBA调用Microsoft Graph API？

问题

是否可以使用VBA代码调用Microsoft Graph API

如果是，如何处理O365授权？我看到很多话题都在说要在Microsoft Azure中创建应用程序以获取令牌，但我很惊讶我必须这样做才能在本地简单使用

我尝试的

在发现Microsoft Graph之后，我在Graph Explorer中尝试了这个API

我能够在planner中创建任务

因此，在我看来，可以从直接在Outlook中执行的VBA代码中调用此API

我在Outlook中创建了此宏：

Sub TaskPlannerCreation()

    Dim PlannerService As New MSXML2.XMLHTTP60
    Dim sData As Variant

    sData = " { ""  ""planId"": ""K9Zv2QHm1U-GSAhd-PTGZfdFeOn"",""bucketId"": ""b6NVNiEIQkGZeBBzn7kWqJvAGvvs"",""title"": ""Outlook task"" } "

    With PlannerService
        .Open "POST", "https://graph.microsoft.com/v1.0/planner/tasks", False
        .setRequestHeader "Content-Type", "application/json"
        .setRequestHeader "Accept", "application/json"
        .setRequestHeader "User-Agent", "xx"
        .Send (sData)

我有一个授权错误

错误代码401

更新日期：2020年3月12日： 在调用Graph Explorer时，找到了一个获取Graph Api令牌分析URL的解决方案（非常适合我）：

---

因此，使用VBA调用Graph API是可能的：）

因此您显示的代码仅部分正确。这是我发现的真正有效的方法。（这是您提供的，因为我发现Json解析器比innerHTML方法更好地处理数据，我还必须使用不同版本的MSXML，因为您引用的MSXML不适用于我。）

---

您需要添加一个。这意味着您需要实现或查找其他人的OAuth客户端的实现（）。我建议阅读本文，并最终使用隐式授权流技术成功地获得了GraphAPI连接的令牌。我认为它对像我这样在VBA和O365授权方面知识贫乏，但有很多需要/想法来提高使用O365的生产率的所有用户都很有用。

Function GetToken()

    Dim xml As New MSXML2.XMLHTTP60
    Dim doc As MSHTML.HTMLDocument
    Dim urltoken As String

'copy paste the URL you see when calling Microsoft Graph Explorer and add prompt + domain_hint parameters
    urltoken = "https://login.microsoftonline.com/common/oauth2/v2.0/authorize?response_mode=form_post&nonce=graph_explorer&mkt=fr-FR&client_id={clientid}&response_type=token&scope=openid profile User.ReadWrite User.ReadBasic.All Sites.ReadWrite.All Contacts.ReadWrite People.Read Notes.ReadWrite.All Tasks.ReadWrite Mail.ReadWrite Files.ReadWrite.All Calendars.ReadWrite&prompt=none&domain_hint=organizations"

    xml.Open "GET", urltoken, False

    xml.Send

    If xml.readyState = 4 And xml.Status = 200 Then
        Set doc = New MSHTML.HTMLDocument
        doc.Body.innerHTML = xml.responseText

        GetToken = doc.getElementsByName("access_token")(0).Value

        sSuccess = True
    Else
         MsgBox "Error" & vbNewLine & "Ready state: " & xml.readyState & _
         vbNewLine & "HTTP request status: " & xml.Status
         sSuccess = False
    End If

    Set xml = Nothing

End Function

Function GetToken()
    Dim xml As New MSXML2.XMLHTTP60
    Dim doc As MSHTML.HTMLDocument
    Dim urltoken As String

    'copy paste the URL you see when calling Microsoft Graph Explorer and add prompt + domain_hint parameters
    urltoken = "https://login.microsoftonline.com/{tenent id}/oauth2/v2.0/token"

    xml.Open "POST", urltoken, False

    xml.Send("client_id={clientid}&scope=https://graph.microsoft.com/.default&grant_type=client_credentials&client_secret=(cleint secret}")

    If xml.readyState = 4 And xml.Status = 200 Then
        Set doc = New MSHTML.HTMLDocument
        doc.Body.innerHTML = xml.responseText

        GetToken = doc.getElementsByName("access_token")(0).Value

        sSuccess = True
    Else
         MsgBox "Error" & vbNewLine & "Ready state: " & xml.readyState & _
         vbNewLine & "HTTP request status: " & xml.Status
         sSuccess = False
    End If

    Set xml = Nothing
End Function