【VBA】Microsoft Graph APIを使って、OneDriveへアップロードする

Microsoft Graph API（REST API）を使って、OneDriveへファイルをアップロードするコードのサンプルです。

【概要①】
・アップロードするファイルをバイナリ形式に変換。
・Microsoft Graph APIを使って、バイナリ形式のデータをアップロード。

前回の記事では、OneDriveのアイテム一覧を取得する方法を紹介しました。
　【VBA】Microsoft Graph APIを使って、OneDriveのアイテム一覧を取得する｜地獄の油揚げ (note.com)
今回はローカル環境に保存してあるファイルを、OneDriveへアップロードする方法を紹介します。
今回の方法を活用すれば、色々なVBA処理に繋げてそのままクラウドストレージ（OneDrive）へ格納する処理が書けるようになります。何かと便利かもしれませんね。

まずは概要①のコードです。
4GB未満のファイルをアップロードするなら、これで十分。

Private Sub Get_OneDrive_Items()
   '１．AzureAD 各設定値
    Const TenantID = "h23409d4-kaer-46h3-93g4g5g58509"
    Const ClientID = "g5kj8839-ffu5-85k9-4hv6-uunnf87gf6r4"
    Const Scope = "Sites.ReadWrite.All  '「openid」「Sites.ReadWrite.All」「User.ReadWrite」"
    Const RedirectURL = "https://www.google.com"
    Const Auth_EndPoint = "https://login.microsoftonline.com/" & TenantID & "/oauth2/v2.0/authorize"  'OAuth 2.0の承認エンドポイント(v2)
    Const Token_EndPoint = "https://login.microsoftonline.com/" & TenantID & "oauth2/v2.0/token"  'OAuth 2.0トークンエンドポイント(v2)
    
    '２．アクセスコード取得
    Dim Param As String
    Param = "response_type=code" & _
                    "&client_id=" & ClientID & _
                    "&scope=" & Scope & _
                    "&redirect_uri" & RedirectURL
    Dim Req As Object 'XMLHTTP60
    Dim Response As String
    Dim S As Integer
    Dim E As Integer
    Dim code As String
    Set Req = CreateObject("MSXML2.XMLHTTP") '=New XMLHTTP60
    Req.Open "GET", Auth_EndPoint & "?" & Param, False
    Req.send
    Response = Req.responsetext
    S = InStr(Response, "code=")
    E = InStr(S + 5, Response, "&session")
    Code = Mid(Response, S + 5, E - S - 5)
    
    '３．アクセスコードを使ってトークン取得
    Dim Req As Object 'XMLHTTP60
    Dim AccessToken As String
    Set Req = CreateObject("MSXML2.XMLHTTP") '=New XMLHTTP60
    Param = "grant_type=authorization_code" & _
                    "&response_type=code" & _
                    "&client_id=" & ClientID & _
                    "&scope=" & Scope & _
                    "&redirect_uri=" & RedirectURL & _
                    "&code=" & code
    Req.Open "POST", Token_EndPoint, False
    Req.setRequestHeader "Content-type", "application/x-www-form-urlencoded"
    Req.send Param
    Response = Req.responsetext
    If InStr(Response, "AADSTS54005") > 0 Then '低確率で出るエラー
        Debug.Print "トークンエンドポイントのレスポンスが正常に受信出来ませんでした。"
        MsgBox "OAuth2 認証コードは既に引き換え済みです。" & vbCrLf & "暫く経ってから、もう一度試してください。"
        End
    End If
    Dim Json As Dictionary 'Object
    Set Json = JsonConverter.ParseJson(Response)
    AccessToken = Json("access_token")
    Set Json = Nothing
    
    '４．バイナリファイルを読み込む
    Dim FilePath As String
    Dim FileName As String
    Dim fso As Object
    Dim Stream 'As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    FilePath = "H:MyDocument\Downloads\IMG_2127.JPG"
    FileName = fso.GetFileName(FilePath)
    Set fso = Nothing
    Set Stream = CreateObject("ADODB.Stream")
    Stream.Open
    Stream.Type = 1 'adTypeBinary
    Stream.LoadFromFile FilePath
    
    '５．小さいファイルをアップロードする
    Dim URL As String
    Const RootURL = "https://graph.microsoft.com/v1.0"
    Const UserID = "xxxxxxxxxxx@xxxxx.com"
    Const RootResource = "/users/" & UserID
    Const URL = RootURL & RootResource & "/drive/items/8C960837-8Y47-8G2H-9475-KK29R8KA29J4:/" & FileName & ":/content"
    Req.Open "PUT", URL, False
    Req.setrequestheader "Content-Type", "text/plain"
    Req.setrequestheader "Authorization", "Bearer " & AccessToken
    Req.send Stream.Read(Stream.Size)
    Response = Req.responsetext
    Set Req = Nothing
End Sub

項目１．～３．の処理は前回記事と全く同じなので、説明割愛します。
４．ではアップロードしたいファイルのフルパスを指定し、ADODB.Streamを使ってバイナリ形式へ変換しています。
５．ではアップロード先のフォルダの指定（上記では「8C960837-8Y…」の部分にある様にファイルのタグ名を指定）し、続けてファイル名も指定（上記では「FileName…」の部分にある様にファイル名を指定）し、最後に「content」を加えたものを、リクエスト先URLに設定します。このURLに対してPUT要求することで、ファイルをアップロードしています。
私が実務で使う分にはこの方法で事足りるので、ここまで書いて私は満足しました。

とはいえ、「4GB以上のファイルも扱うんだけど…！」という人のために、アップロードセッションを使ったアップロード方法も紹介します。
【概要②】
・アップロードするファイルをバイナリ形式に変換。
・Microsoft Graph APIを使って、アップロードセッションを作成。
・アップロードセッションにバイナリ形式のデータをアップロード。

   '５．アップロードセッションを作成する
    Dim URL As String
    Const RootURL = "https://graph.microsoft.com/v1.0"
    Const UserID = "xxxxxxxxxxx@xxxxx.com"
    Const RequestURL = RootURL & "/users/" & UserID & "/drive/items/8C960837-8Y47-8G2H-9475-KK29R8KA29J4:/" & FileName & ":/createUploadSession"
    Param = "{""item"":{ ""@microsoft.graph.conflictBehavior"": ""rename""}}" 'JSON形式で記入
    Req.Open "POST", RequestURL, False
    Req.setrequestheader "Content-Type", "application/json"
    Req.setrequestheader "Authorization", "Bearer " & AccessToken
    Req.send Param
    Response = Req.responsetext
    Dim uploadURL As String
    S = InStr(Response, "uploadUrl")
    E = InStr(S + 12, Response, """}")
    uploadURL = Mid(Response, S + 12, E - S - 12)
    If uploadURL <> "" Then Debug.Print "uploadURLを正常に取得しました"
    
    '６．アップロードセッションにバイトをアップロードする
    Req.Open "PUT", uploadURL, False
    Req.setrequestheader "Content-Type", "application/json"
    Req.setrequestheader "Content-Length", Stream.Size
    Req.setrequestheader "Content-Range", "bytes 0-" & Stream.Size - 1 & "/" & Stream.Size
    Req.setrequestheader "Authorization", "Bearer " & AccessToken
    Req.send Stream.Read(Stream.Size)
    Response = Req.responsetext
    Set Req = Nothing

ファイルをバイナリ形式に変換するところまでは、処理が一緒なので割愛。
見ての通り、５．でアップロードセッションを作成し、６．でアップロードしています。
実際にアップロードセッションを使ったアップロード方法を実装する場合は、上記コードに加えて、バイナリデータを分割して小分けにアップロードしていく処理を適宜加える必要があります。
ここまで読んで頂いた諸兄ならば、さくっと対応可能でしょう。。
公式レファレンスの要求例の様に（レファレンスでは26バイトづつ）、分割したバイナリデータを順次送っていけばOKかと。
　再開可能なファイル アップロード - OneDrive API - OneDrive dev center | Microsoft Learn

公式レファレンスにVBA言語での実装例も載せてくれると、分かりやすいんだけどなぁ。