ExcelからAccessクエリ取り込み

Sub ExtractDataFromAccess()
    Dim conn As Object ' ADO Connection
    Dim rs As Object ' ADO Recordset
    Dim strConn As String
    Dim strSQL As String
    Dim i As Integer
    Dim j As Integer

    ' Access データベースへの接続文字列を設定（IDとパスワードあり）
    strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\path\to\your\database.accdb;User ID=YourUserID;Password=YourPassword;"

    ' SQL クエリを設定
    strSQL = "SELECT * FROM YourQueryName;"

    ' ADO Connection オブジェクトを作成
    Set conn = CreateObject("ADODB.Connection")

    ' ADO Recordset オブジェクトを作成
    Set rs = CreateObject("ADODB.Recordset")

    ' Access データベースに接続
    conn.Open strConn

    ' SQL クエリを実行して結果を Recordset に格納
    rs.Open strSQL, conn

    ' Recordset のデータを Excel に出力
    ' ヘッダーを書き込む
    For i = 0 To rs.Fields.Count - 1
        Cells(1, i + 1).Value = rs.Fields(i).Name
    Next i

    ' データを書き込む
    For i = 0 To rs.RecordCount - 1
        For j = 0 To rs.Fields.Count - 1
            Cells(i + 2, j + 1).Value = rs.Fields(j).Value
        Next j
        rs.MoveNext
    Next i

    ' メモリの解放
    rs.Close
    conn.Close
    Set rs = Nothing
    Set conn = Nothing

    MsgBox "Data extraction completed.", vbInformation

End Sub