複数のレコードを取得する方法

質問

VB６とデータベース(ACCESS2003)で
ADOを利用して「条件に一致するレコードを取得する」ということを勉強しています。
選択クエリーを指定してリストボックスに取得したデータを表示させています。

そこで質問なのですが
条件に一致するレコードが複数ある場合、それらをすべてリストボックスに表示させる方法を教えてほしいのです。
一番最初のデータしか表示されません（泣）
宜しくお願いします。

回答No.2

noname#22222

1980年代に一斉を風靡したリレーショナルデータベース言語にInformixというのがあります。
Perform_というSQLの実行結果を簡単に画面に表示するアプリケーションが添付しておりました。

SQL文の入力欄があって[実行]ボタンを押すと、次のように結果が表示されるというものです。

SELECT_*_FROM_TABLE1;

_ID|ssss|生年月日__|
---|-------------------
__1|A_|____|1949/05/01|
__2|B_|____|__________|

SELECT_*_FROM_ListName;

___|ID|名前_____|住所____________________________|生年月日__|
---|---------------------------------------------------------
__1|_1|山田_太郎|東京都__________________________|1980/01/01|
__2|_2|鈴木_一郎|大阪府__________________________|1980/02/02|
__3|_3|中村_主水|福岡市__________________________|1980/03/03|

もちろん、INSERT文、UPDATE文、DELETE文も実行できます。
まあ、「SQL文で取得したデータをセットする関数]の一つの集大成ではないでしょうか？

さて、この＜Perform＞は、某HPで完全に再現されているようです。
ソースコードも完全に公開されています。
なお、<<<DBSelect関数>>>も同一のHPに収録されています。
　　　~~~~~~~~~~~~~~~~~~

※HPの存在は知っていますが、URIまでは覚えていません。
※Yahooの検索でも使って探して下さい。

お礼

回答ありがとうございます！
返事が遅くなり申し訳ございませんでした。

回答No.1

noname#22222

次が、リストボックスにSQL文で取得したデータをセットする関数です。
表示形式に変換の部分が SQL Server のそれになっています。
そこを Access 用に変換すればいいです。
なお、列データの連結文字が';'でなくVB6.0用に修正する必要があるかも知れません。
が、いずれにしろ、ADOでリストボックスの値を設定する全てのノウハウが詰まっています。

' -------------------------------------------------------------------------------------------------------
'　DBSelect(列リスト,
'　　　　　 表名,
'　　　　　 グループ指定文,
'　　　　　 条件文,
'　　　　　 並び替え文,
'　　　　　 isOneSentence, ---- 列データをセミコロン(;)で連結して１文にするか否か？
'　　　　　 isConvert) -------- 列データを表示形式に変換してから配列に代入するか否か？
' -------------------------------------------------------------------------------------------------------
Public Function DBSelect(ByVal strFields As String, _
　　　　　　　　　　　　 ByVal strTable As String, _
　　　　　　　　　　　　 Optional strGroupBy As String, _
　　　　　　　　　　　　 Optional strWhere As String, _
　　　　　　　　　　　　 Optional strOrderBy As String, _
　　　　　　　　　　　　 Optional isOneSentence As Boolean = False, _
　　　　　　　　　　　　 Optional isConvert As Boolean = False) As Variant
On Error GoTo Err_DBSelect
　　Dim I　　　　　 As Integer
　　Dim J　　　　　 As Integer
　　Dim R　　　　　 As Integer　　' データを代入する配列 DataValue(,) のインデックスを決める行カウンター
　　Dim C　　　　　 As Integer　　' データを代入する配列 DataValue(,) のインデックスを決める列カウンター
　　Dim M　　　　　 As Integer　　' データを代入する配列 DataValue(,) の一つ目の添字の最大値=行総数 - 1
　　Dim N　　　　　 As Integer　　' データを代入する配列 DataValue(,) の二つ目の添字の最大値=列総数 - 1
　　Dim strQuerySQL As String
　　Dim rst　　　　 As ADODB.Recordset
　　Dim fld　　　　 As ADODB.Field
　　Dim strList　　 As String　　 ' 全てのデータをセミコロン(;)で区切った１行の文字列を格納する変数

　　Set rst = New ADODB.Recordset

　　strQuerySQL = "SELECT " & strFields & " FROM " & strTable
　　If Len(strGroupBy) > 0 Then
　　　　strQuerySQL = strQuerySQL & " GROUP BY " & strGroupBy
　　End If
　　If Len(strWhere) > 0 Then
　　　　strQuerySQL = strQuerySQL & " WHERE " & strWhere
　　End If
　　If Len(strOrderBy) > 0 Then
　　　　strQuerySQL = strQuerySQL & " ORDER BY " & strOrderBy
　　End If
　　' =================
　　'　Begin With: rst
　　' -----------------
　　With rst
　　　　 .Open strQuerySQL, _
　　　　　　　 CurrentProject.Connection, _
　　　　　　　 adOpenStatic, _
　　　　　　　 adLockReadOnly
　　　　 If Not .BOF Then
　　　　　　' --------------
　　　　　　'　配列を再宣言
　　　　　　' --------------
　　　　　　M = .RecordCount - 1
　　　　　　N = .Fields.Count - 1
　　　　　　If M > 99 Then
　　　　　　　　MsgBox "読込む行総数を100行に下方修正しました。(DBSelect)", vbInformation, " お知らせ"
　　　　　　　　M = 99
　　　　　　End If
　　　　　　ReDim DataValues(M, N)
　　　　　　' ------------------------------------
　　　　　　'　列情報を For-Next で配列に代入する
　　　　　　' ------------------------------------
　　　　　　.MoveFirst
　　　　　　For R = 0 To M
　　　　　　　　C = -1
　　　　　　　　For Each fld In .Fields
　　　　　　　　　　' =================
　　　　　　　　　　'　Begin With: fld
　　　　　　　　　　' -----------------
　　　　　　　　　　With fld
　　　　　　　　　　　　C = C + 1
　　　　　　　　　　　　If Not isConvert Then
　　　　　　　　　　　　　　DataValues(R, C) = Nz(.Value, "")
　　　　　　　　　　　　Else
　　　　　　　　　　　　　　' --------------------------
　　　　　　　　　　　　　　'　列データを表示形式に変換
　　　　　　　　　　　　　　' -------------------------
　　　　　　　　　　　　　　Select Case .Type
　　　　　　　　　　　　　　　　Case adBoolean　　　　　　　　　' ブール型
　　　　　　　　　　　　　　　　　　DataValues(R, C) = IIf(.Value = -1, "Yes", "No")
　　　　　　　　　　　　　　　　Case adChar, adVarChar　　　　　' 文字列型
　　　　　　　　　　　　　　　　　　DataValues(R, C) = Nz(.Value, "")
　　　　　　　　　　　　　　　　Case adDBDate, adDBTimeStamp　　' 日付型(yyyymmdd)、日付/時刻型(yyyymmddhhmmss + 1/10億)
　　　　　　　　　　　　　　　　　　DataValues(R, C) = .Value
　　　　　　　　　　　　　　　　Case adSmallInt, adInteger　　　' 整数
　　　　　　　　　　　　　　　　　　DataValues(R, C) = FormatNumber(.Value, 0)
　　　　　　　　　　　　　　　　Case adSingle, adDouble　　　　 ' 浮動小数点型
　　　　　　　　　　　　　　　　　　DataValues(R, C) = FormatNumber(.Value, 2)
　　　　　　　　　　　　　　　　Case adCurrency　　　　　　　　 ' 通貨型
　　　　　　　　　　　　　　　　　　DataValues(R, C) = FormatCurrency(.Value, 2)
　　　　　　　　　　　　　　　　Case Else
　　　　　　　　　　　　　　　　　　DataValues(R, C) = .Value
　　　　　　　　　　　　　　End Select
　　　　　　　　　　　　End If
　　　　　　　　　　End With
　　　　　　　　　　' ---------------
　　　　　　　　　　'　End With: fld
　　　　　　　　　　' ===============
　　　　　　　　Next fld
　　　　　　　　.MoveNext
　　　　　　Next R
　　　　 Else
　　　　　　ReDim DataValues(0, 0)
　　　　　　DataValues(0, 0) = ""
　　　　　　strList = ""
　　　　 End If
　　End With
　　' ---------------
　　'　End With: rst
　　' ===============
　　If isOneSentence Then
　　　　' -------------------------------
　　　　'　セミコロン(;)で連結して１文に
　　　　' -------------------------------
　　　　For I = 0 To M
　　　　　　For J = 0 To N
　　　　　　　　strList = strList & DataValues(I, J) & ";"
　　　　　　Next J
　　　　Next I
　　End If
Exit_DBSelect:
On Error Resume Next
　　rst.Close
　　Set rst = Nothing
　　DBSelect = IIf(isOneSentence, strList, DataValues())
　　Exit Function
Err_DBSelect:
　　MsgBox "SELECT 文の実行時にエラーが発生しました。(DBSelect)" & Chr$(13) & Chr$(13) & _
　　　　　　"・Err.Description=" & Err.Description & Chr$(13) & _
　　　　　　"・SQL Text=" & strQuerySQL, _
　　　　　　vbExclamation, " 関数エラーメッセージ"
　　Resume Exit_DBSelect
End Function

お礼

回答ありがとうございます！
返事が遅くなり申し訳ございませんでした。

また質問なのですが、
「SQL文で取得したデータをセットする関数」について書かれているWEBサイトがありましたら教えてもらえないでしょうか？
宜しくお願いします。