【Excel VBA】SharePointのListと接続する

List操作のクラスを作成

コネクションオブジェクトを定義

Option Explicit
Private objCon As New ADODB.Connection

データベース接続用の関数を作成

ByValは値渡し

Public Function DBOpen (ByVal tableName As String) As Boolean
On Error GoTo Err

    Dim connectionString As String = vbNullString
    connectionString = "Provider=Microsoft.ACE.OLEDB.12.0;WSS;IMEX=0;RetrieveIds=Yes;DATABASE=SharePointのURL;LIST=" & tableName & ";"

    objCon.Open connectionString

    DBOpen = True
    Exit Function

Err:
    DBOpen = False
End Function

クエリ実行用の関数を作成

ByRefは参照渡し

Public Function execQuery (ByVal strSQL As String, ByRef objRS As ADODB.Recordset) As Boolean
On Error GoTo Err

    Dim adoRS As New ADODB.Recordset

    With adoRS
        If .State = 1 Then .Close

        .ActiveConnection = objCon
        .CursorType = adOpenDynamic
        .CursorLocation = adUseClient
        .LockType = adLockOptimistic
        .Sorce = strSQL
        .Open
    End With

    Set objRS = adoRS
    execQuery = True
    Exit Function

Err:
    execQuery = False
End Function

データベース切断用の関数を作成

Public Function DBClose() As Boolean
On Error GoTo Err

    objCon.Close
    DBClose = True
    Exit Function

Err:
    DBClose = False
End Function

モジュールからインスタンス生成して関数を呼び出す

Sub モジュール名
    Dim objDB As Object
    Dim objRS As ADODB.Recordset
    Dim strSQL As String
    Set objDB = New クラス名
    
    If Not objDB.DBOpen("テーブル名") Then GoTo Err
    strSQL = "SELECT * FROM テーブル名;"
    
    If Not objDB.execQuery(strSQL, objRS) Then
        objDB.DBClose
        GoTo Err
    End If
    
    If 0 < objRS.RecordCount Then
        Do While Not objRS.EOF
            Debug.Print objRS.Fields("カラム名").Value
        Loop
    End If
    
    If Not objDB.DBClose() Then GoTo Err

Err:
    Set objDB = Nothing
    Set objRS = Nothing
End Sub