IT Hands-on Lab

小規模組織向けIT環境の構築・運用に役立つ情報を、ハンズオン形式で紹介しています。

【Excel VBA⇔Cloud】ADO×ExcelOnlineデータ検索&更新

【Excel VBA⇔Cloud】ADO×ExcelOnlineデータ検索&更新

Excel VBAのデータベースアクセスライブラリADO(ActiveX Data Objects)を使用して、SharePoint Online上にあるExcelファイルのデータ検索・更新を行う方法を紹介します。
  • 操作環境(*):
    • OS:Windows 11
    • Webブラウザー:Edge
  • 使用プラン:Microsoft 365 Business Premium
    *SharePoint Online上のExcelファイルにアクセスできる組織アカウントでサインインしていること

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

 

 

SharePoint Online上のExcelファイル用意

以前の記事で、Excel VBAのデータベースアクセスライブラリADOを使用し、SharePointリストのデータ検索・更新を行う方法を紹介しました。
今回はデータソースをSharePointリストからSharePoint Online上のExcelファイルに変更して、データ検索・更新のVBAを実装してみます。
相違比較しやすいよう、データは同じものを使用します。

図表1-1 データソースExcelファイルの用意

図表1-1 データソースExcelファイルの用意


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

図表1-2 データソースExcelファイルのアップロード・同期

図表1-2 データソースExcelファイルのアップロード・同期

 

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

図表1-3 同期されたSharePointサイトのドキュメント

図表1-3 同期されたSharePointサイトのドキュメント

 

実行用Excelファイル用意

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

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

図表2-1 ExcelファイルのMainシート

図表2-1 ExcelファイルのMainシート

 

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

図表2-2 ExcelファイルのSearchシート

図表2-2 ExcelファイルのSearchシート

 

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

図表2-3 ExcelファイルのRenewシート

図表2-3 ExcelファイルのRenewシート

 

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

図表2-4 ExcelファイルのVBAプロジェクト

図表2-4 ExcelファイルのVBAプロジェクト

 

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

図表2-5 VBAプロジェクトの参照設定

図表2-5 VBAプロジェクトの参照設定

 

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ファイルのプログラムによるデータ検索・更新の参考になれば幸いです。

 

 

当ブログ内の関連記事

elmgrn.hatenablog.com

elmgrn.hatenablog.com