可変の検索条件件数でAccessデータを抽出

質問

http://okwave.jp/qa/q8790348.html　ここで質問をさせて頂いたのですが
私の質問方法が下手で、違う意味合いになっていましたので再度投稿させてください。

■　やりたい事
ADOを用いて、Accessのテーブル内のフィールドに「指定の数値」がある場合
その行を全てExcelに抽出したい

■　特徴
「指定の数値」は複数あり、なおかつ可変。
　→ VBAで作成したコンボボックス（Accessから読込）にて選択し、F45から下に好きな個数だけ追加

■　つまづき点
「指定の数値」全てを検索対象に（OR検索）して
SQLのSelect文で取得しようとしてもやり方が分からない

■　現在のコード
'宣言
Private adoCn As Object
Private adoRs As Object
Private strSQL As String
Private Const DBpath = "\Access.mde"

Sub DBconnect(flg As Boolean) 'DB呼出
Set adoCn = CreateObject("ADODB.Connection")
If flg = True Then Set adoRs = CreateObject("ADODB.Recordset")
adoCn.Open "Provider=Microsoft.jet.OLEDB.4.0;Data Source=" & DBpath & ";"

End Sub

Sub 対象()

Dim tmpFldCnt As Variant
Dim tmpRecCnt As Integer
Dim buf() As Variant

Call DBconnect(True)

m = Worksheets("選択").Range("B47")

Dim i As Long
Dim j As Long

i = 45
j = 44 + Worksheets("選択").Range("B47") 'B47：コンボボックスで選んだ個数分の数値

On Error GoTo err_hander
adoCn.BeginTrans 'トランザクション処理開始

strSQL = _
"select * from TBL where コード = [選択$F" & i & ":F" & j & "]"

'F45より下に取得した値が入っていく

adoRs.Open strSQL, adoCn, adOpenKeyset 'SQLを実行して、対象をadoRsへ

tmpFldCnt = adoRs.Fields.Count
tmpRecCnt = adoRs.RecordCount

Range("M28:DG31").ClearContents

ReDim buf(tmpFldCnt - 1, tmpRecCnt - 1)
buf = adoRs.GetRows

Range(Cells(28, 13), Cells(28 + tmpFldCnt - 1, 13 + tmpRecCnt - 1)) = buf

adoCn.CommitTrans 'トランザクション終了
Call DBcut_off(True) 'DB切断呼び出し

Exit Sub

色々と調べてみたものの、解決する気配がせず、どなたか知恵をお貸しください。

回答No.1

piroin654 · ベストアンサー

http://okwave.jp/qa/q8790348.html

のNo7で述べましたように、この場合は上記の場合とは
方法が違いますので、以下のようにしてみてください。
なお、データは引き続き上記の場合と同じとします。

以下の場合は、IDが2から4までのデータを連続して
取り出します。こういう場合はSQL文を

strSQL = "SELECT * FROM Tdata WHERE ID Between [startNum] And [endNum]"

のように、WHERE ID Between AAA And BBB　というコードを使います。
つまり、この場合はAAAからBBBまでのIDの数値に合致するレコードを
対象にするということです。WHERE句でレコードにフィルタをかけます。
なお、以下ではADOのCommandを使いますのでRecordsetはCommandで指定した
SQL文が対象となります。したがって、ADOの接続や切断、オブジェクトの
破棄等は、プロシージャの中に書き込んでください。Recordsetの設定の
順序も違っています。

なお、途中いくつかはこちらの環境設定ですので、実際の環境に合わせて設定してください。
たとえば、

　　cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strPath

は、Jet.OLEDB.4.0　のところを実際の環境に設定しなおしてください。
たぶん、ここだけと思いますが。それと、Accessのファイル名と取り出す
範囲のところですかね。

　　Dim cn As New ADODB.Connection
　　Dim rs As New ADODB.Recordset
　　Dim cmd As New ADODB.Command
　　Dim pam As New ADODB.Parameter
　　Dim strSQL As String
　　Dim i As Long
　　Dim j As Long
　　Dim k As Long
　　Dim strPath As String

　　'IDの2から4までのレコードを取り出します。
　　'ここは実際に合わせて設定しなおしてください。
　　i = 2
　　j = 4

　　strSQL = "SELECT * FROM Tdata WHERE ID Between [startNum] AND [endNum]"
　　strPath = ThisWorkbook.Path & "\sample.mdb"
　　cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strPath

　　Set cmd.ActiveConnection = cn

　　With cmd
　　　　.CommandText = strSQL
　　　　.CommandType = adCmdText
　　　　.Prepared = True
　　End With

　　'startNumをパラメータとして登録。 数値としてadNumericを引数として指定
　　Set pam = cmd.CreateParameter("startNum", adNumeric)
　　cmd.Parameters.Append pam
　　cmd.Parameters("startNum") = i

　　'endNumをパラメータとして登録。数値としてadNumericを引数として指定
　　Set pam = cmd.CreateParameter("endNum", adNumeric)
　　cmd.Parameters.Append pam
　　cmd.Parameters("endNum") = j

　　'データの取り出し
　　Set rs = cmd.Execute

　　'Sheetへのデータの格納
　　If rs.EOF Then
　　　　MsgBox "レコードがありません。"
　　Else
　　　　i = rs.Fields.Count
　　　　k = 1
　　　　Do Until rs.EOF
　　　　　　For j = 1 To i
　　　　　　　　If Not rs.Fields(j - 1).Name = "年齢" Then
　　　　　　　　　　Worksheets("Sheet1").Cells(j, k) = rs.Fields(j - 1)
　　　　　　　　End If
　　　　　　Next j
　　　　　　k = k + 1
　　　　　　rs.MoveNext
　　　　Loop
　　End If

　　'後処理
　　rs.Close: Set rs = Nothing
　　Set cmd = Nothing
　　cn.Close: Set cn = Nothing

お礼

回答ありがとうございます、無事自分の思い描いていた挙動になってくれました。
ありがとうございました。