Accessでの検索結果表示

質問

Accessでの検索画面を作っているのですが
*検索項目*
・顧客ID
・電話番号
・氏名（前方一致で検索したい）

*顧客テーブル*
・顧客ID
・電話番号
・氏名
・氏名カナ
・住所

3つを複合的な検索項目として、検索ボタンを押下した際に
フォーム上のテキストボックスに顧客テーブルから
検索した住所を表示させたいと思っています。

現在、顧客コードだけを
検索項目として以下のようなコードを記述しているのですが
これでさえもうまくいきません。

***************************
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim strRet As String

Set cn = CurrentProject.Connection
rs.Open "顧客テーブル", cn, adOpenKeyset, adLockOptimistic
strRet = "顧客ID='" & Me!CustmID & "' "

rs.Find strRet

If Not rs.EOF Then
Me.Address = rs!住所

Else: MsgBox "該当なし"
End If

rs.Close: Set rs = Nothing
cn.Close: Set cn = Nothing

End Sub

****************************
現状、何が悪いのかそしてどのようにこのプログラムを
改良すれば本来やりたいことができるのか
教えていただけますでしょうか。よろしくお願いいたします。

回答No.3

CHRONOS_0

>クエリでは対応できないのかなと思っていますがいかがでしょうか。

確かに追加更新ができなくなるクエリというものもありますが
普通の選択クエリなら追加・更新は可能です

追加更新が不可になるケースについてはヘルプに詳しい説明がありますので
調べてみてください

回答No.2

CHRONOS_0

仕様に難ありですよ
>・氏名（前方一致で検索したい）
ということだと該当するものが複数というケースが考えられます
テキストボックスに表示だと1件しか表示できませんね

条件が複数という点からも複数ヒットの可能性があります

この程度のことならVBAを引っ張り出すまでもないですね

素直にクエリで表示でいいのではないですか
条件入力フォームにテキストボックスを3つ置き
入力後ボタンクリックで、クエリを開くなり
クエリをソースとしたフォームを開いてやればいいですね(ここだけVBAかな)

クエリでは

顧客IDの抽出条件欄に
=[Forms]![フォーム名]![text顧客ID]

電話番号の抽出条件欄に
=[Forms]![フォーム名]![text電話番号]

氏名の抽出条件欄に
Like [Forms]![フォーム名]![text氏名] & "*" And [Forms]![フォーム名]![text氏名] Is Not Null

抽出条件はORになりますから行を変えて入力します
入力しなかった条件は無視されます

補足

ご指摘ありがとうございます。
このツールには先の話があり、表示させた項目を変更して
DBにアップデートしたりコピー追加したりしたいので
クエリでは対応できないのかなと思っていますがいかがでしょうか。

回答No.1

noname#22222

Ｑ、ミスは？
Ａ、strRet = "顧客ID=" & Me!CustmID

でバグはなくなるでしょう！
ところで、少し、次のようなテーブルと検索フォームを作成してテストしてみました。
いずれにしろ、書くべきフォームのコードは１０行以内です。

＜顧客マスター＞
ID　　氏名　　　　住所
1　　　鈴木 一郎　東京
2　　　中村 主水　大阪
3　　　木村 太郎　京都

この場合の検索フォームのコードは、

Private Sub コマンド0_Click()
　　If Len(Me.ID & "") > 0 Then
　　　　Me.氏名 = DBLookup("氏名", "顧客マスター", "ID=" & Me.ID)
　　　　Me.住所 = DBLookup("住所", "顧客マスター", "ID=" & Me.ID)
　　End If
End Sub

難点は、一々、レコードセットをオープンしていることです。
これを改善したのが、次です。

Private Sub コマンド1_Click()
　　Dim Datas() As String

　　If Len(Me.ID & "") > 0 Then
　　　　Datas() = DBSelects("氏名,住所", "顧客マスター", , "ID=" & Me.ID)
　　　　If Len(Datas(0, 0)) > 0 Then
　　　　　　Me.氏名 = Datas(0, 0)
　　　　　　Me.住所 = Datas(0, 1)
　　　　Else
　　　　　　Me.氏名 = ""
　　　　　　Me.住所 = ""
　　　　End If
　　End If
End Sub

Datas(レコードインデックス、フィールドインデックス)

となっています。

DBSelects() は、該当するレコードの列情報を配列に読み込む関数です。
質問者の知りたい情報は、これらの関数が網羅していると思います。

Public Function DBLookup(ByVal strField As String, _
　　　　　　　　　　　　 ByVal strTable As String, _
　　　　　　　　　　　　 Optional ByVal strWhere As String = "", _
　　　　　　　　　　　　 Optional ByVal ReturnValue = Null) As Variant
On Error GoTo Err_DBLookup
　　 Dim DataValue
　　 Dim strQuerySQL As String
　　 Dim rst　　　　 As ADODB.Recordset

　　 Set rst = New ADODB.Recordset
　　 strQuerySQL = "SELECT " & strField & " FROM " & strTable
　　 If Len(strWhere) > 0 Then
　　　　 strQuerySQL = strQuerySQL & " WHERE " & strWhere
　　 End If
　　 With rst
　　　　 .Open strQuerySQL, _
　　　　　　　 CurrentProject.Connection, _
　　　　　　　 adOpenStatic, _
　　　　　　　 adLockReadOnly
　　　　 If Not .BOF Then
　　　　　　 .MoveFirst
　　　　　　 DataValue = .Fields(0)
　　　　 End If
　　 End With
Exit_DBLookup:
On Error Resume Next
　　 rst.Close
　　 Set rst = Nothing
　　 DBLookup = Nz(DataValue, ReturnValue)
　　 Exit Function
Err_DBLookup:
　　 MsgBox "SELECT 文の実行時にエラーが発生しました。(DBLookup)" & Chr$(13) & Chr$(13) & _
　　　　　　"・Err.Description=" & Err.Description & Chr$(13) & _
　　　　　　"・SQL Text=" & strQuerySQL, _
　　　　　　vbExclamation, " 関数エラーメッセージ"
　　 Resume Exit_DBLookup
End Function

Public Function DBSelects(ByVal strFields As String, _
　　　　　　　　　　　　　ByVal strTable As String, _
　　　　　　　　　　　　　Optional strGroupBy As String, _
　　　　　　　　　　　　　Optional strWhere As String, _
　　　　　　　　　　　　　Optional strOrderBy As String) As String()
On Error GoTo Err_DBSelects
　　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 DataValues() 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行に下方修正しました。(DBSelects)", vbInformation, " お知らせ"
　　　　　　　　M = 99
　　　　　　End If
　　　　　　ReDim DataValues(M, N)
　　　　　　' ------------------------------------
　　　　　　'　列情報を For-Next で配列に代入する
　　　　　　' ------------------------------------
　　　　　　.MoveFirst
　　　　　　For R = 0 To M
　　　　　　　　C = -1
　　　　　　　　For Each fld In .Fields
　　　　　　　　　　C = C + 1
　　　　　　　　　　DataValues(R, C) = Nz(fld.Value, "")
　　　　　　　　Next fld
　　　　　　　　.MoveNext
　　　　　　Next R
　　　　 Else
　　　　　　ReDim DataValues(0, 0)
　　　　　　DataValues(0, 0) = ""
　　　　 End If
　　End With
　　' ---------------
　　'　End With: rst
　　' ===============
Exit_DBSelects:
On Error Resume Next
　　rst.Close
　　Set rst = Nothing
　　DBSelects = DataValues()
　　Exit Function
Err_DBSelects:
　　M = 0
　　MsgBox "SELECT 文の実行時にエラーが発生しました。(DBSelects)" & Chr$(13) & Chr$(13) & _
　　　　　　"・Err.Description=" & Err.Description & Chr$(13) & _
　　　　　　"・SQL Text=" & strQuerySQL, _
　　　　　　vbExclamation, " 関数エラーメッセージ"
　　Resume Exit_DBSelects
End Function

補足

ありがとうございます。
この場合、検索画面のIDをNullで電話番号のみで検索した場合ひっかからないとおもいます。それはここをいじればいいのかなとおもうのですが
If Len(Me.ID & "") > 0 Then
このチェックはどういう意味があるのでしょうか？
また、ご指摘いただいたように結果が２レコード以上ある場合は
検索条件を絞り込むようメッセージをだしたいのですが、
可能でしょうか、よろしくお願いいたします。