
- 操作環境(*):
- OS:Windows 11
- Webブラウザー:Edge
- 使用プラン:Microsoft 365 Business Premium
*SharePoint Online上のExcelファイルにアクセスできる組織アカウントでサインインしていること
なお、この記事では、VBAの使用許可や開発メニュー表示といった初期設定や、VBAエディタの使い方の説明は割愛いたします。
- SharePoint Online上のExcelファイル用意
- 実行用Excelファイル用意
- Excel VBAによるデータ検索実装
- Excel VBAによるデータ更新実装
- ADO未使用のデータ更新の代替案
- おわりに
SharePoint Online上のExcelファイル用意
以前の記事で、Excel VBAのデータベースアクセスライブラリADOを使用し、SharePointリストのデータ検索・更新を行う方法を紹介しました。
今回はデータソースをSharePointリストからSharePoint Online上のExcelファイルに変更して、データ検索・更新のVBAを実装してみます。
相違比較しやすいよう、データは同じものを使用します。

SharePointサイトのドキュメントに用意したExcelファイルをアップロードします。
さらに、右上の[・・・]から[同期]を選択します。

エクスプローラーが起動し、同期されたSharePointサイトのドキュメントが表示されます。
このように、クラウド上のExcelファイルをデータソースとして、ADOでデータ処理を行う場合、同期を実施してエクスプローラー越しにアクセスできるようにしておく必要があります。

実行用Excelファイル用意
VBAを実行するExcelファイルを用意します(拡張子はxlsm)。
- Menuシート:各ボタン(ActiveXコントロール)を押すと、SharePoint上のExcelファイルに接続し、データの検索や更新を行います。

- Searchシート:Menuシートの[書籍データ検索]ボタンを押すと、SharePoint上のExcelファイルの検索結果をこのシートに出力します。

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

- VBAプロジェクト:Mainシート上にスクリプトを実装します。

VBA実行時にADOに関するエラーが発生する場合は、[ツール>参照設定]を選択し、[Microsoft ActiveX Data Objects x.x Library]のチェックをオンにします。

Excel VBAによるデータ検索実装
基本的にAccessやExcelのデータ検索と同じで、以下がポイント事項です。
- コネクション設定時のデータソースについて、同期したExcelのローカルパス(図表1-3で確認)を指定する
- コネクション設定時の拡張プロパティについて、IMEXは読み取り優先モード(1)を指定する
- 検索時のテーブル名を大カッコ[]で囲む
Private Sub searchSPExcelBook()
'定数宣言
Const wb_db_url As String = "C:\Users\SystemAdmin\{テナント名}\{サイト名} - General\test_spo_xls_data.xlsx"
Const adOpenKeyset = 1 'CursorType:0=順方向,1=キーセット,2=動的,3=静的,-1=未指定
Const adLockReadOnly = 1 'LockType:1=読取専用,2=レコード毎悲観的ロック,3=レコード毎楽観的ロック,4=楽観的バッチ更新
'変数宣言(Excel関連)
Dim wb As Workbook
Dim ws As Worksheet
'変数宣言(SQL関連)
Dim conn As Object
Dim res As Object
Dim sql As String
'変数宣言(処理変数)
Dim cnt_row As Long
Dim cnt_col As Long
Dim max_row As Long
Dim max_col As Long
'出力先ワークシート(このExcel)の設定 、データ初期化
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Search")
ws.Rows("1:" & ws.Range("A" & ws.Rows.Count).End(xlUp).Row).Delete
'コネクションの設定
Set conn = CreateObject("ADODB.Connection")
conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
wb_db_url & ";Extended Properties=""Excel 12.0 Xml;HDR=YES;IMEX=1"";"
'レコードセットの設定、レコードセット取得(SELECT文実行)
Set res = CreateObject("ADODB.Recordset")
sql = "SELECT * FROM [data$] ORDER BY ID;"
res.Open sql, conn, adOpenKeyset, adLockReadOnly
'検索結果の行列数を求める
max_row = res.RecordCount 'タイトル行はカウントされない
max_col = res.Fields.Count
'レコードセットをSearchシートに書き出す
For cnt_row = 0 To max_row - 1
For cnt_col = 0 To max_col - 1
If (cnt_row = 0) Then 'タイトル行
ws.Cells(cnt_row + 1, cnt_col + 1) = res(cnt_col).Name
End If
If (cnt_col = 0) Then 'データ行(ID列)
ws.Cells(cnt_row + 2, cnt_col + 1) = res(cnt_col).Value
Else 'データ行(ID列以外)
ws.Cells(cnt_row + 2, cnt_col + 1) = "'" & res(cnt_col).Value
End If
Next cnt_col
res.MoveNext
Next cnt_row
'レコードセットとコネクションのクローズ
res.Close
Set res = Nothing
conn.Close
Set conn = Nothing
End Sub
Excel VBAによるデータ更新実装
基本的にAccessやExcelのデータ検索と同じで、以下がポイント事項です。
- コネクション設定時のデータソースについて、同期したExcelのローカルパス(図表1-3で確認)を指定する
- コネクション設定時の拡張プロパティについて、IMEXは書き込み優先モード(0)を指定する
- 検索時のテーブル名を大カッコ[]で囲む
- データ追加時のIDの値はSharePointリストと違って自動採番されないため、データソース内の最大値を基準に連番とする
Private Sub renewSPExcelBook()
'定数宣言
Const wb_db_url As String = "C:\Users\SystemAdmin\{テナント名}\{サイト名} - General\test_spo_xls_data.xlsx"
Const adOpenDynamic = 2 'CursorType:0=順方向,1=キーセット,2=動的,3=静的,-1=未指定
Const adLockOptimistic = 3 'LockType:1=読取専用,2=レコード毎悲観的ロック,3=レコード毎楽観的ロック,4=楽観的バッチ更新
Const adSearchForward = 1 'searchDirection:1=前方から検索,-1=後方から検索
'変数宣言(Excel関連)
Dim wb As Workbook
Dim ws As Worksheet
'変数宣言(SQL関連)
Dim conn As Object
Dim res As Object
Dim sql As String
'変数宣言(処理変数)
Dim cnt_row As Long
Dim cnt_col As Long
Dim max_row As Long
Dim max_col As Long
Dim array_name As Variant
Dim array_value As Variant
Dim new_id As Long
'更新元ワークシートの設定
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Renew")
'コネクションの設定
Set conn = CreateObject("ADODB.Connection")
conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
wb_db_url & ";Extended Properties=""Excel 12.0 Xml;HDR=YES;IMEX=0"";"
'ID列の最大値取得
Set res = CreateObject("ADODB.Recordset")
sql = "SELECT MAX(ID) FROM [data$];"
res.Open sql, conn, adOpenDynamic, adLockOptimistic
new_id = CLng(res(0).Value)
res.Close
'レコードセットの設定、レコードセット取得(SELECT文実行)
Set res = CreateObject("ADODB.Recordset")
sql = "SELECT * FROM [data$] ORDER BY ID;"
res.Open sql, conn, adOpenDynamic, adLockPessimistic
'Renewシートの最大行列数を求める(タイトル行とaction列を除く)
max_row = ws.Range("A" & ws.Rows.Count).End(xlUp).Row - 1
max_col = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column - 1
'データ反映で使用するvariant変数のサイズを定義する
ReDim array_name(max_col - 1)
ReDim array_value(max_col - 1)
'データ反映対象のタイトル行をvariant変数に格納する(action列を除く)
For cnt_col = 0 To max_col - 1
array_name(cnt_col) = ws.Cells(1, cnt_col + 2)
Next cnt_col
With res
For cnt_row = 0 To max_row - 1
'データ反映対象のデータ行をvariant変数に格納する(action列を除く)
For cnt_col = 0 To max_col - 1
If ws.Cells(cnt_row + 2, cnt_col + 2) <> "" Then
array_value(cnt_col) = ws.Cells(cnt_row + 2, cnt_col + 2).Value
Else
If cnt_col = 0 And ws.Cells(cnt_row + 2, 1).Value = "ins" Then
array_value(cnt_col) = new_id + 1 'データ追加時のID列
Else
array_value(cnt_col) = Null
End If
End If
Next cnt_col
'データ反映を行う
If ws.Cells(cnt_row + 2, 1).Value = "ins" Then 'データ追加
.AddNew array_name, array_value
new_id = new_id + 1
ElseIf ws.Cells(cnt_row + 2, 1).Value = "upd" Then 'データ変更
.MoveFirst
.Find "ID = " & ws.Cells(cnt_row + 2, 2).Value, 0, adSearchForward
.Update array_name, array_value
ElseIf ws.Cells(cnt_row + 2, 1).Value = "del" Then 'データ削除
.MoveFirst
.Find "ID = " & ws.Cells(cnt_row + 2, 2).Value, 0, adSearchForward
.Delete '実行時エラー発生(-2147217887(80040e21))
End If
Next cnt_row
End With
'レコードセットとコネクションのクローズ
res.Close
Set res = Nothing
conn.Close
Set conn = Nothing
End Sub
しかし、90行目のDelete処理で実行時エラーが発生(-2147217887(80040e21))し、データ削除が機能しません。この問題の代替案をこの後紹介します。
ADO未使用のデータ更新の代替案
ADOによるデータ削除が機能しなかったため、代替案としてADOを使用しないデータ更新のコードを紹介します。
同期したExcelファイルを開いて処理しています。Offset等によるセル操作でデータ反映を行うため、ADOの場合と比べると、その部分のコードがやや煩雑でしょうか。
Private Sub renewSPExcelBook2()
'定数宣言
Const wb_db_url As String = "C:\Users\SystemAdmin\{テナント名}\{サイト名} - General\test_spo_xls_data.xlsx"
'変数宣言(Excel関連)
Dim wb As Workbook
Dim ws As Worksheet
Dim wb_db As Workbook
Dim ws_db As Worksheet
'変数宣言(処理変数)
Dim cnt_row As Long
Dim cnt_col As Long
Dim max_row As Long
Dim max_col As Long
Dim last_row As Long
Dim new_id As Long
Dim db_cell As Range
'更新元ワークシートの設定
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Renew")
'更新先ワークシート(このExcel)の設定 、データ初期化
Set wb_db = Workbooks.Open(wb_db_url)
Set ws_db = wb_db.Worksheets("data")
'Renewシートの行列数を求める(タイトル行とaction列,ID列を除く)
max_row = ws.Range("A" & ws.Rows.Count).End(xlUp).Row - 1
max_col = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column - 2
For cnt_row = 0 To max_row - 1
'データ反映を行う
If ws.Cells(cnt_row + 2, 1).Value = "ins" Then 'データ追加
last_row = ws_db.Range("A" & ws.Rows.Count).End(xlUp).Row '更新先WSの最終行
new_id = Application.WorksheetFunction.Max(ws_db.Range("A:A")) '更新先WSのID列最大値
For cnt_col = 0 To max_col - 1
If (cnt_col = 0) Then 'ID列の値を反映
ws_db.Cells(last_row + 1, 1).Value = new_id + 1
End If
'category列以降の列の値を反映
ws_db.Cells(last_row + 1, cnt_col + 2).Value = _
"'" & ws.Cells(cnt_row + 2, cnt_col + 3).Value
Next cnt_col
ElseIf ws.Cells(cnt_row + 2, 1).Value = "upd" Then 'データ変更
For Each db_cell In ws_db.Range("A:A") '更新先WSのID列を検索
If (db_cell = CLng(ws.Cells(cnt_row + 2, 2).Value)) Then '更新先WS/元WSのID列の値が一致
For cnt_col = 0 To max_col - 1 'category列以降の列の値を反映
db_cell.Offset(0, cnt_col + 1) = "'" & ws.Cells(cnt_row + 2, cnt_col + 3).Value
Next cnt_col
End If
Next db_cell
ElseIf ws.Cells(cnt_row + 2, 1).Value = "del" Then 'データ削除
For Each db_cell In ws_db.Range("A:A") '更新先WSのID列を検索
If (db_cell = CLng(ws.Cells(cnt_row + 2, 2).Value)) Then '更新先WS/元WSのID列の値が一致
ws_db.Rows(db_cell.Row).Delete '更新先WSの該当行を削除
Exit For
End If
Next db_cell
End If
Next cnt_row
'更新先ワークシートを保存して閉じる
Application.DisplayAlerts = False
wb_db.Close SaveChanges:=True
End Sub
おわりに
ExcelVBAのADOを使用してSharePoint上のExcelファイルのデータ検索・更新を行う方法を紹介しました。
以前の記事で紹介したSharePointリストのデータ検索・更新と比べると、同期が必要だったり、データ削除が動作しなかったりと、扱いの異なる点があります。
SharePointで共同管理・バージョン管理をしたいExcelファイルのプログラムによるデータ検索・更新の参考になれば幸いです。
当ブログ内の関連記事