Sub Excel→Accessデータ抽出()
Dim AccessPath As String
Dim AccessQuery As String
Dim ConnectionString As String
Dim Conn As Object
Dim RS As Object
Dim ExcelApp As Object
Dim ExcelSheet As Object
Dim i As Long
Dim paramValue1 As String
Dim paramValue2 As String
Dim paramValue3 As String
Dim paramValue4 As String
Dim paramValue5 As String
' Accessデータベースのパスを取得
AccessPath = Sheets("Sheet1").Range("B2").Value
' パラメータ値の取得（例：Sheet1のC2からG2までのセルから）
paramValue1 = Sheets("Sheet1").Range("C2").Value
paramValue2 = Sheets("Sheet1").Range("D2").Value
paramValue3 = Sheets("Sheet1").Range("E2").Value
paramValue4 = Sheets("Sheet1").Range("F2").Value
paramValue5 = Sheets("Sheet1").Range("G2").Value
' AccessクエリのSQL文を設定（パラメータを含む）
AccessQuery = "SELECT * FROM YourQueryName WHERE YourParameter1 = '" & paramValue1 & "' AND " & _
"YourParameter2 = '" & paramValue2 & "' AND " & _
"YourParameter3 = '" & paramValue3 & "' AND " & _
"YourParameter4 = '" & paramValue4 & "' AND " & _
"YourParameter5 = '" & paramValue5 & "';"
' 接続文字列の作成
ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & AccessPath & ";" & _
"Persist Security Info=False;"
' ADOの接続オブジェクト作成
Set Conn = CreateObject("ADODB.Connection")
' ADO接続のオープン
Conn.Open ConnectionString
' ADOレコードセット作成
Set RS = Conn.Execute(AccessQuery)
' Excelアプリケーションの起動
Set ExcelApp = CreateObject("Excel.Application")
' 新しいワークブックの作成
ExcelApp.Workbooks.Add
' ワークシートの取得（Sheet2）
Set ExcelSheet = ExcelApp.ActiveWorkbook.Sheets("Sheet2")
' ヘッダ行の作成
For i = 0 To RS.Fields.Count - 1
ExcelSheet.Cells(1, i + 1).Value = RS.Fields(i).Name
Next i
' データの転記
ExcelSheet.Range("A2").CopyFromRecordset RS
' クエリ実行結果の表示
RS.Close
Conn.Close
' Excelの表示
ExcelApp.Visible = True
' クリーンアップ
Set RS = Nothing
Set Conn = Nothing
Set ExcelSheet = Nothing
Set ExcelApp = Nothing
End Sub
Excel→Accessデータ抽出(ADO利用、パラメータ条件ある場合)
