情シス仕事の備忘録

自身の備忘録を兼ねて、情シス仕事で役に立ちそうな情報を掲載しています

Excel VBA ⇔ Cloud データ検索&更新(API×SharePointリスト)

Excel VBAでMicrosoft Graph REST API(SharePoint REST API v2)を使用して、クラウド上にあるSharePointリストのデータ検索・更新を行う方法を紹介します。

・操作環境(※):
 ・OS:Windows 11
 ・Webブラウザー:Edge
・使用プラン:Microsoft 365 Business Premium
※SharePointリストおよびMicrosoft Graph APIにアクセスできる組織アカウントでサインインしていること

なお、この記事では、VBAの使用許可や開発メニュー表示といった初期設定や、VBAエディタの使い方の説明は割愛いたします。

 

 

SharePointを操作するためのAPIについて

SharePointを操作するためのAPIは二種類あります。この記事では後出のMicrosoft Graph REST APIを使用した例を紹介します。
Microsoft Graph REST APIの使用方法は公式記事に掲載されています。この記事で参考にした公式記事を以下に列挙します。

 

Microsoft Graph REST APIによるSharePointリストの操作は発展途上なのか、列の種類がハイパーリンクの項目に対しデータ追加・変更ができない等、制限事項があるようです。
以下の画面はAPI開発ツール「Postman」でハイパーリンクの項目にデータ変更を試した時に発生したエラーの状況です。この記事の最後の方で紹介するデータ更新のソース内では、ハイパーリンクの項目の追加・変更部分をコメントアウトして処理をスキップします。

 

MS Entra管理センターでAPIの初期設定を行う

以前の記事で紹介したDataverse Web APIの設定と流れは同じです。
WebブラウザーよりMicrosoft Entra管理センターにアクセスし、左メニューの[ID>アプリケーション>アプリの登録]を選択し、[新規登録]を選択します。
※Microsoft Entra管理センター:Microsoft Entra admin center

 

以下の通り設定し、[登録]を選択します。
・名前:(SharePoint APIの接続用アプリであることが分かる名前)
・アカウントの種類:この組織ディレクトリのみに含まれるアカウント
・リダイレクトURL(選択肢):Web
・リダイレクトURL(値):https://localhost

 

登録が完了し、サブメニューの[概要]画面に遷移したら、以下の値を控えておきます。
・アプリケーション(クライアント)ID
・ディレクトリ(テナント)ID

 

サブメニューの[APIのアクセス許可]を選択し、[アクセス許可の追加]を選択します。

 

[Microsoft API]タブを選択し、[Microsoft Graph]を選択します。

 

以下の通り設定し、[アクセス許可の追加]を選択します。
・アプリケーションに必要なアクセス許可の種類:アプリケーションの許可
・アクセス許可:Sites>Sites.Read.All、Sites.ReadWrite.All

 

以下の通り設定し、[xxxxxに管理者の同意を与えます]を選択します。
管理者の同意確認に関するメッセージが表示されたら、[はい]を選択します。

 

サブメニューの[証明書とシークレット]を選択し、[クライアントシークレット]タブを選択し、[新しいクライアントシークレット]を選択します。

 

以下の通り設定し、[追加]を選択します。
・説明:(SharePoint APIの接続用シークレットであることが分かる名前)
・有効期限:(適宜設定)
元の画面で今追加したクライアントシークレットの値を控えておきます。

 

SharePointリストを用意する

Excel VBAのADOでSharePointリストにデータ検索・更新した以前の記事と同様、この例でも書籍管理アプリのSharePointリストを使用します。
このSharePointリストの作成方法や項目定義はこちらの記事をご覧ください。

対象のSharePointリストAPIで必要となるSharePointのサイトIDとリストIDを確認します。
まずは、SharePoint管理センターで対象のサイトを選択します。

 

サイトの設定画面のURLの最後(SiteDetails/の後)の値がサイトIDですので、これを控えておきます。
続けて、[サイトの表示]を選択します。

 

左メニューの[サイトコンテンツ]を選択し、対象のSharePointリスト(この例では[書籍管理])を選択します。

 

SharePointリストの一覧画面左上の設定アイコンを選択し、[リストの設定]を選択します。

 

リストの設定画面のURLから、リストIDを特定します。
・リストID:”List=%7Bxxxxxxxx-xxxx-xxxx-xxxxxxxxxxxx%7D”の”xxxxxxxx-xxxx-xxxx-xxxxxxxxxxxx”部分

 

APIが認識する列の物理名の確認方法について補足します。
先ほどのサイトの設定画面の各列を選択すると、URLから列の物理的な名前を確認できます。
この例では、author(著者)という列を用意しましたが、実はSharePointリストで内部的に保持している列の物理名と値が被っています。

 

列の設定画面のURLの最後(Fields=の後)の値が列の物理名ですので、APIで列名を指定する際はこの値を使用します(この例では[author0])。
APIで列名が正常に認識されない場合、この方法で物理名が異なっていないか確認すると、問題が解消するかもしれません。

 

Excelファイルを用意する

VBAを実行するExcelファイルを用意します(拡張子はxlsm)。

・Menuシート:各ボタン(ActiveXコントロール)を押すと、SharePointリストに接続し、データの検索や更新を行います。

 

・Searchシート:Menuシートの[書籍管理データ検索]ボタンを押すと、SharePointリストの検索結果をこのシートに出力します。


・Renewシート:このシートに追加・変更・削除対象(Action列で識別)のデータを入力しておき、Menuシートの[書籍管理データ反映]ボタンを押すと、SharePointリストに反映されます。

 

・VBAプロジェクト:Mainシート上にソースを実装します。画面に表示されているのは検索・更新ボタンクリック時にデータ検索・更新の関数を呼び出すソースです。

 

Web APIのデータのやり取りはJson型というデータフォーマットを使用します。下記WebサイトにVBA用の変換モジュールJsonConverter.basがあるので、ダウンロードします。
※JsonConverter入手先:GitHub - VBA-tools/VBA-JSON: JSON conversion and parsing for VBA

 

ダウンロードしたZIPを展開しておきます。VBAのプロジェクトエクスプローラ上で右クリックし、[ファイルのインポート]を選択します。
展開したファイル内のJsonConverter.basを選択します。
VBAのプロジェクトエクスプローラー上に、[標準モジュール>JsonConverter]が表示されます。

 

[ツール>参照設定]を選択し、[Microsoft Scripting Runtime]のチェックをオンにします。
これが未実施の場合、API呼び出し時のHTTPリクエストオブジェクトの作成でエラーが発生します。

 

PostmanでAPIの動作確認を行う(推奨)

いきなりVBAで実装するのではなく、先にAPI開発ツール「Postman」で認証およびデータ検索・更新時のデータのやりとりを確認することをおススメします。
Postmanの入手方法は以前の記事を参考にしてください。

この例におけるPostmanの設定および動作確認の方法を紹介します。

まずは環境を新規作成します。コレクションに直接設定値をベタ打ちもできますが、同じ接続先に色々なリクエストを試したい場合、ここで設定を変数化しておくと便利です。セキュアな情報はタイプをシークレットにします。
・access_token_url: https://login.microsoftonline.com/{{tenant_id}}/oauth2/v2.0/token
・tenant_id:工程2で控えたディレクトリ(テナント)ID
・client_id:工程2で控えたアプリケーション(クライアント)ID
・client_secret:工程2の最後に控えたクライアントシークレット
・scope: https://graph.microsoft.com/.default
・grant_type:client_credentials
・url: https://graph.microsoft.com/v1.0/sites/{{site_id}}/lists/{{list_id}}/items
・site_id:工程3で控えたサイトID
・list_id:工程3で控えたリストID
※{{xxx}}はxxxという変数として扱われます

 

コレクションにデータ検索用のリクエストを新規作成します。
・メソッド:GET
・URL:{{url}}?$expand=fields($select=category,status,borrower,borrowed_date,isbn_code,
published_date,book_name,author0,publisher,memo,thumbnail)
※この例では全件検索としています。Postman設定時、URLの値内のisbn_codeの後ろの改行は削除してください
・ヘッダー>Accept:application/json


[認可]タブを選択し、左側の項目を以下の通りとします。
・Auth Type:OAuth 2.0
・認可データの追加先:リクエストヘッダー


同じ画面の下の方の[新しいトークンの設定]を以下の通り設定し、[新しいアクセストークンを取得]を選択します。
・トークン名:(適宜設定)
・Grantタイプ:クライアント資格認証
・アクセストークンURL:{{access_token_url}}
・クライアントID:{{client_id}}
・クライアントシークレット:{{client_secret}}
・Scope:{{scope}}
・クライアント認証:Basic認証ヘッダーとして認証
・トークンリクエスト:
 ・キー:grant_type
 ・値:{{grant_type}}
 ・追加先:Request Body

 

アクセストークンが作成されたら、[Proceed]を選択します。
[Use Token]を選択します。

 

[現在のトークン]の[トークン]欄に作成されたトークンの値が反映されます。
ヘッダー接頭辞が[Bearer]になっていることを確認し、[送信]を選択します。

 

リクエスト送信結果は画面下部に表示されます。
データ検索の場合はテーブルのデータがJson型で表示されます。

 

データ追加の場合は、以下のような設定となります。
・メソッド:POST
・URL: {{url}}
・[認可]タブ:(データ検索時と同じ)
・ヘッダー>Content-Type:application/json
・[ボディ]タブ:(追加対象データをJson型で設定)(※)
※{ "name1":value1(num), "name2":"value2(string)","name3","value3(yyyy-mm-dd)" }のような形となります

 

データ変更の場合は、以下のような設定となります。
・メソッド:PATCH
・URL: {{url}}/<idの値>
・[認可]タブ:(データ検索・追加・削除時と同じ)
・ヘッダー>Content-Type:(データ追加・削除時と同じ)
・[ボディ]タブ:(データ追加時と同様、変更対象データをJson型で設定)

データ削除の場合は、以下のような設定となります。
・メソッド:DELETE
・URL: (データ変更時と同じ)
・[認可]タブ:(データ検索・追加・変更時と同じ)
・ヘッダー>Content-Type:(データ追加・変更時と同じ)

 

Excel VBAでSharePointリストのデータを検索する

データ検索のメインとなるプロシージャのソースです。ポイント事項は以下の通りです。

  • API実行時の認証情報は、[Authorization]というキー名で、[Bearer {アクセストークン}](アクセストークンはサブ関数で取得)の値をHTTPヘッダーに渡している
  • 検索結果はJson型の変数apiJsonで取得し、エラーがあれば詳細情報をダイアログ表示する。なお、エラー発生時のレスポンスの書式はこちらの記事を参考にした
  • SharePointリストで自動反映されるキー項目(id列)はパラメーターとして指定しなくても取得できる(むしろ指定不要である)
  • 検索が正常終了した時のデータの取り出し方法は、Postmanでデータ検索を実行した時の書式に基づいている
Private Sub searchSPListBook()

  '変数宣言
  Dim wb As Workbook
  Dim ws As Worksheet
  Dim apiMethod As String
  Dim apiUrl As String
  Dim apiBody As String
  Dim apiParams As String
  Dim apiHeaders As New Dictionary
  Dim apiJson As Object
  Dim keys  As Variant
  Dim cnt_row As Long
  Dim cnt_col As Long
  
  '出力先ワークシートの設定 、データ初期化
  Set wb = ThisWorkbook
  Set ws = wb.Worksheets("Search")
  ws.Rows("1:" & ws.Range("A" & ws.Rows.Count).End(xlUp).Row).Delete
  
  'データ検索
  apiMethod = "GET"
  apiUrl = "https://graph.microsoft.com/v1.0/sites/{サイトID}/lists/{リストID}/items"
  apiBody = ""
  apiParams = "?$expand=fields($select=category,status,borrower,borrowed_date," & _
    "isbn_code,published_date,book_name,author0,publisher,memo,thumbnail)"
  apiHeaders.RemoveAll
  apiHeaders.Add "Content-type", "application/json"
  apiHeaders.Add "Authorization", getAccessToken() 'トークン取得
  Set apiJson = callRestApi(apiMethod, apiUrl, apiBody, apiParams, apiHeaders) 'API実行
  
  'データ検索でエラーが発生した場合、ダイアログを表示する
  If apiJson.Exists("error") Then
    MsgBox "データ検索でエラーが発生しました。:" & apiJson("error")("code") & _
      ":" & apiJson("error")("message"), vbOKOnly, "データ検索エラー"
    Exit Sub
  End If
  
  '取得データ項目を定義する
  keys = Array("id", "category", "status", "borrower", "borrowed_date", _
    "isbn_code", "published_date", "book_name", "author0", "publisher", _
    "memo", "thumbnail")

  'レコードセットsearchシートに書き出す
  For cnt_row = 0 To apiJson("value").Count - 1
    For cnt_col = 0 To UBound(keys)
      If cnt_row = 0 Then
        ws.Cells(cnt_row + 1, cnt_col + 1) = keys(cnt_col) 'タイトル行の書き出し
      End If
      If keys(cnt_col) = "id" Then 'データ行の書き出し(id列)
        ws.Cells(cnt_row + 2, cnt_col + 1) = _
          "'" & apiJson("value")(cnt_row + 1)(keys(cnt_col))
      ElseIf keys(cnt_col) = "thumbnail" Then 'データ行の書き出し(thumbnail列)
        If apiJson("value")(cnt_row + 1)("fields").Exists(keys(cnt_col)) Then '値なし時の考慮
          ws.Cells(cnt_row + 2, cnt_col + 1) = _
            "'" & apiJson("value")(cnt_row + 1)("fields")(keys(cnt_col))("Description")
        End If
      Else 'データ行の書き出し(その他の列)
        ws.Cells(cnt_row + 2, cnt_col + 1) = _
          "'" & apiJson("value")(cnt_row + 1)("fields")(keys(cnt_col))
      End If
    Next cnt_col
  Next cnt_row
  
End Sub

※{サイトID}、{リストID}は工程3で確認した値とし、カッコ{ }は不要です

 

データ検索のメインプロシージャから呼び出しているサブ関数のソースです(アクセストークン取得、API実行)。ポイント事項は以下の通りです。

  • API実行関数は、アクセストークン取得やデータの検索・変更・削除で共通の関数としたため、それぞれの処理で不要なパラメータも一旦渡す扱う形とした(例えばアクセストークン取得時、params,headerは不要だが、引数として一旦渡している)
  • API実行関数の最後に、工程4でインポートしたJsonConverterのJson型変換関数を呼び出している。この関数は戻り値がNothing(データ更新が正常終了したとき)だとエラー扱いとなるため、一旦これをスルーして、メイン関数でエラー判定することとした
'*****************************************
' getAccessToken:アクセストークン取得
'*****************************************
Private Function getAccessToken() As String

  Dim apiMethod As String
  Dim apiUrl As String
  Dim apiBody As String
  Dim apiParams As String
  Dim apiHeaders As New Dictionary
  Dim apiJson As Object

  'リクエスト情報の格納
  apiMethod = "POST"
  apiUrl = "https://login.microsoftonline.com/{テナントID}/oauth2/v2.0/token"
  apiBody = "client_id={クライアントID}" & _
    "&client_secret={クライアントシークレット}" & _
    "&grant_type=client_credentials" & _
    "&scope=https://graph.microsoft.com/.default"
  apiParams = ""
  apiHeaders.RemoveAll
  
  'レスポンスをJsonに格納する
  Set apiJson = callRestApi(apiMethod, apiUrl, apiBody, apiParams, apiHeaders) 'API実行
  
  'Json型からアクセストークンを取り出して返す
  getAccessToken = apiJson("token_type") & " " & apiJson("access_token")

End Function

'*****************************************
' callRestApi:API実行(アクセストークン取得時を含む)
'*****************************************
Private Function callRestApi(method As String, url As String, body As String, params As String, headers As Dictionary) As Object

  Dim http As Object
  Dim cnt As Long
  
  'データ削除の正常終了時、戻り値がNothingのため
  'ParseJsonでエラー扱いになる。これをスルーする
  On Error Resume Next
  
  'httpリクエストオブジェクトの設定
  Set http = CreateObject("msxml2.xmlhttp") '参照設定Microsoft Scripting Runtime要
  http.Open method, url & params, False
  
  'httpリクエストヘッダーの設定
  For cnt = 0 To headers.Count - 1
    http.setRequestHeader headers.keys(cnt), headers.Items(cnt)
  Next cnt
  
  'リクエスト送信
  If body = "" Then
    http.send
  Else
    http.send (body)
  End If
  
  'レスポンスの文字列をJson型に変換して返す
  Set callRestApi = JsonConverter.ParseJson(http.responseText)

End Function

※{テナントID}、{クライアントID}、{クライアントシークレット}は工程2で確認した値とし、カッコ{ }は不要です

 

Excel VBAでSharePointリストのデータを更新する

データ更新(追加・変更・削除)のメインとなるプロシージャのソースです。ポイント事項はデータ検索と重複するので特にありません。

Private Sub renewSPListBook()
  
  '変数宣言
  Dim wb As Workbook
  Dim ws As Worksheet
  Dim apiMethod As String
  Dim apiUrl As String
  Dim apiBody As String
  Dim apiParams As String
  Dim apiHeaders As New Dictionary
  Dim apiJson As Object
  Dim keys  As Variant
  Dim cnt_row As Long
  Dim cnt_col As Long
  Dim array_name As Variant
  Dim array_value As Variant
  
  '出力先ワークシートの設定
  Set wb = ThisWorkbook
  Set ws = wb.Worksheets("Renew")

  'Renewシートの最大行列数を求め、データ反映で使用するvariant変数のサイズを定義する
  max_row = ws.Range("A" & ws.Rows.Count).End(xlUp).Row - 1
  max_col = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column - 1
  ReDim array_name(max_col - 2)
  ReDim array_value(max_col - 2)
  
  'データ反映対象のタイトル行をvariant変数に格納する(action,id列をのぞく)
  For cnt_col = 0 To max_col - 2
    array_name(cnt_col) = ws.Cells(cnt_row + 1, cnt_col + 3)
  Next cnt_col
  
  apiParams = "" 'データ更新では設定値がないので空文字とする
  
  For cnt_row = 0 To max_row - 1
  
    'データ反映対象のデータ行をvariant変数に格納する(action,id列をのぞく)
    For cnt_col = 0 To max_col - 2
      If ws.Cells(cnt_row + 2, cnt_col + 3) <> "" Then
        array_value(cnt_col) = ws.Cells(cnt_row + 2, cnt_col + 3).Value
      Else
        array_value(cnt_col) = Null
      End If
    Next cnt_col
    
    'HTTPヘッダーの初期化・格納
    apiHeaders.RemoveAll
    apiHeaders.Add "Content-Type", "application/json"
    apiHeaders.Add "Authorization", getAccessToken() 'トークン取得
    
    'HTTPメソッド,Url,Bodyの格納
    If ws.Cells(cnt_row + 2, 1).Value = "ins" Then 'データ追加
      apiMethod = "POST"
      apiUrl = "https://graph.microsoft.com/v1.0/sites/{サイトID}/lists/{リストID}/items"
      apiBody = getBody(array_name, array_value) 'ボディ格納
    ElseIf ws.Cells(cnt_row + 2, 1).Value = "upd" Then 'データ変更
      apiMethod = "PATCH"
      apiUrl = "https://graph.microsoft.com/v1.0/sites/{サイトID}/lists/{リストID}/items" _
        & "/" & ws.Cells(cnt_row + 2, 2).Value
      apiBody = getBody(array_name, array_value) 'ボディ格納
    ElseIf ws.Cells(cnt_row + 2, 1).Value = "del" Then 'データ削除
      apiMethod = "DELETE"
      apiUrl = "https://graph.microsoft.com/v1.0/sites/{サイトID}/lists/{リストID}/items" _
        & "/" & ws.Cells(cnt_row + 2, 2).Value
      apiBody = ""
    End If
    
    'リクエスト送信・レスポンス格納
    Set apiJson = callRestApi(apiMethod, apiUrl, apiBody, apiParams, apiHeaders) 'API実行
    
    'エラーが発生した場合、ダイアログを表示する
    If Not apiJson Is Nothing Then
      If apiJson.Exists("error") Then
        MsgBox CStr(cnt_row + 1) & "番目のデータ反映でエラーが発生しました。:" & _
          apiJson("error")("code") & ":" & apiJson("error")("message"), vbOKOnly, _
          "データ反映エラー"
      End If
    End If
    
  Next cnt_row
  
End Sub

※{サイトID}、{リストID}は工程3で確認した値とし、カッコ{ }は不要です


データ更新のメインプロシージャから呼び出しているサブ関数(データ検索と重複する関数を除く)のソースです(ボディ格納)。ポイント事項は以下の通りです。

  • ソースの最初のコメント部分に記載した通り、データの型に合わせて、値を”で囲む/囲まない、日付の形式の調整といった処理を行っている
  • この記事の冒頭で述べた通り、ハイパーリンク列はMicrosoft Graph APIのデータ追加・更新に対応していないため、対象外としている
'*****************************************
' getBody:ボディ格納(データ追加・変更用)
' { "name1":value1(num), "name2":"value2(string)","name3","value3(yyyy-mm-dd)" }
'*****************************************
Private Function getBody(array_name As Variant, array_value As Variant) As String

  Dim cnt_col As Long
  Dim apiBody As String
  
  apiBody = "{" & """" & "fields" & """" & ":{"
  For cnt_col = 0 To UBound(array_name)
    If IsNull(array_value(cnt_col)) = False Then
      If cnt_col > 0 Then
        apiBody = apiBody & ","
      End If
      If array_name(cnt_col) = "id" Then '数値:id列
        apiBody = apiBody & """" & array_name(cnt_col) & """" & ":" & array_value(cnt_col)
      ElseIf array_name(cnt_col) = "thumbnail" Then  'リンク:thumbnail列
        'GraphAPIがSPListのHyperLink列の更新に未対応のため、更新除外
        'apiBody = apiBody & """" & array_name(cnt_col) & """" & ": {" _
        '  & """" & "Description" & """" & ":" & """" & array_value(cnt_col) & """" & "," _
        '  & """" & "Url" & """" & ":" & """" & array_value(cnt_col) & """" & "}"
      Else 'その他
        apiBody = apiBody & """" & array_name(cnt_col) & """" & ":" _
          & """" & array_value(cnt_col) & """"
      End If
    End If
  Next
  apiBody = apiBody & "}}"
    
  'Bodyの値を返す
  getBody = apiBody

End Function

 

おわりに

長くなってしまいましたが、前の記事で紹介したDataverse Web APIを使用する場合とやっていることは殆ど同じです。その前の記事で紹介したADOでSharePointリストに接続する方法と比べると、APIの初期設定の手間はかかりますが、APIの扱いに慣れれば苦にならないですし、VBAから他のWebアプリへの作り替えがしやすくなると思います。

SharePointリストのREST APIは二種類あり、この記事では後出のMicrosoft Graph REST APIを使用しました。この記事の最初の方で述べた通り、2024年10月末時点では制限事項がありますが、状況変化をキャッチしましたらこの記事に反映したいと思います。