アクセスに登録した値を条件検索によりtextboxに反映させる方法を教えてください。

質問

はじめまして。お世話になります。

Accessで登録した値をVBのフォーム上のテキストボックスに
反映させる方法を教えてください。

[Accessのファイル名]
db1.mdb

[db1.mdbのテーブル名]
ListName

[ListNameの各項目]
日付、名前、住所、生年月日

[VBのフォーム]
lbldate、text1.textbox、text2.textbox、text3.textbox、Select.command

※lbldateの内容は日付(テキスト型)でCaptionでとってきた値が「日付」項目に登録される。
3つのtextboxには入力した値は「名前」・「住所」・「生年月日」項目に登録される。(すべてテキスト型)

[自分で調べ考えたコーディングの内容]
Microsoft DAO 3.6 Object Library参照設定

Private Sub Select_Click()

Dim strSQL As String
Dim dbs As DAO.Database
Dim myset As DAO.Recordset
Dim ws As DAO.Workspace

Set ws = DBEngine.Workspaces(0)
Set dbs = ws.OpenDatabase("C:\db1.mdb")

Me.AutoRedraw = True
strSQL = "SELECT * FROM Listname where 日付 = '" & lbldate & "'; "

Set myset = dbs.OpenRecordset(strSQL)

Text1.Text = CStr(myset("名前"))
Text2.Text = CStr(myset("生年月日"))
Text3.Text = CStr(myset("住所"))

myset.Close

End Sub

上記の内容では上手くいきません。過去にテキストボックスに入力した値を教えていただきましたが今回は逆にレコードを検索して選択する方法が上手くいきません。
アドバイスをよろしくお願い致します。

※求める機能としてlblnameに表示される値を条件にそれに対応するレコードを選択したいのですが検索時に該当する日付がなかった場合は3つのテキストボックスに値を何も返さないプログラムにしたいと思っています。よろしくお願い致します。

回答No.8

noname#22222 · ベストアンサー

＊＊＊＊＊
　おまけ
＊＊＊＊＊

さて、 DBLookup は、レコード情報を一気に取得することが出来ません。
これでは、汎用性がありません。
一応の汎用形を示しておきます。

? DBLookup("SELECT * FROM テーブル1", "C:\Temp\db1.mdb")
1;鈴木;一郎;

このように、セミコロン(;)で区切られた文字列として全ての列データを戻します。
これで、コンボボックス等のリストをDBLookup()でも設定できます。
使用方法は、次のようです。
メインのコードは、とてもシンプルになる筈です。

' -------------------------------------------
' DBLookup() でレコードデータを Datas に取得
' -------------------------------------------
Datas=DBLookup("SELECT * FROM テーブル1", "C:\Temp\db1.mdb")
' ------------------------------
' Datas をテキストボックスに代入
' ------------------------------
Me.Text1 = CutStr(Datas, ";", 1)　' 1
Me.Text2 = CutStr(Datas, ";", 2)　' 鈴木
Me.Text3 = CutStr(Datas, ";", 3)　' 一郎

Public Function DBLookup(ByVal strQuerySQL As String, _
　　　　　　　　　　　　 ByVal strDBPath As String) As String
On Error GoTo Err_DBlookup
　　Dim I　　　As Integer
　　Dim N　　　As Integer
　　Dim Datas　As String
　　Dim dbs As DAO.Database
　　Dim rst As DAO.Recordset

　　Set dbs = DBEngine.Workspaces(0).OpenDatabase(strDBPath)
　　Set rst = dbs.OpenRecordset(strQuerySQL)
　　With rst
　　　　If Not .EOF Then
　　　　　　N = .Fields.Count - 1
　　　　　　For I = 0 To N
　　　　　　　　Datas = Datas & .Fields(I) & ";"
　　　　　　Next I
　　　　End If
　　End With
Exit_DBlookup:
On Error Resume Next
　　rst.Close
　　dbs.Close
　　DBLookup = Datas
　　Exit Function
Err_DBlookup:
　　MsgBox Err.Description
　　Resume Exit_DBlookup
End Function

Public Function CutStr(ByVal Text As String, _
　　　　　　　　　　　 ByVal Separator As String, _
　　　　　　　　　　　 ByVal N As Integer) As String
　　Dim strDatas() As String

　　strDatas = Split("" & Separator & Text, Separator, , 0)
　　CutStr = strDatas(N * Abs((N <= UBound(strDatas))))
End Function

※毎度、データベースにアクセスしてデータを取得する手続きを書くのはミスの元です。
※何らかの汎用化する工夫をしたらと思います。
※色んな方法がありますが、DBLookup()、CutStr()を組み合わせる方法は参考になるかも知れません。
※真似ではなく、自前の DBLookup()、CutStr()を作れば実力アップ間違いなしです。

回答No.7

noname#22222

Text1.Text = DBLookup("SELECT 名前 FROM Listname WHERE 日付 = '" &
lblNow_date.Caption
& "'")

以下のように訂正！

strQuerySQL = "SELECT 名前 FROM Listname WHERE 日付 = '" & lblNow_date.Caption & "'"
MsgBox strQuerySQL

Text1.Text = DBLookup(strQuerySQL)

'2006/8/2' <> '2006/08/02'

です！
日付は、"yyyy/mm/dd" で統一しないと・・・。

お礼

お世話になっています。

アドバイスどおりだとうまくいかなかったのですがMsgboxを使用しlblNow_date.Caption の値がとれているのか確認したところ値がとれてなかったのでもう一度プログラム全体を見直し考えたところ別のプロシージャー内で定義していたため値を上手く取得できていませんでした。
必要な箇所で定義したら上手く値を取得することができました。
いろいろとお教えいただいて本当にありがとうございます。
これを機に自分自身で再度、勉強しようと思います。ありがとうございました。

回答No.6

kabilunlun

「カレントレコードがありません。」ということは、SQL自体に間違いはなく、条件に合致するレコードがないということですね。

フィールド「日付」は本当にテキスト型ですか。日付型だったりしませんか。
テキスト型で間違いないのであれば、試しにlbldateのCaptionを使用せずに、直接値を指定して試してください。

ある一つのレコードの「日付」の値が2006/08/01だとしたら、
strSQL = "SELECT * FROM Listname where 日付 = '2006/08/01'"
これでだめなら念のため、
strSQL = "SELECT * FROM Listname where 日付 = #2006/08/01#"
を試してみてください。
2つ目のSQLで抽出できたならフィールド「日付」は日付型ということになりますが。

回答No.5

noname#22222

s_husky です。

これは、SQLを列毎に確認するテスト用です。
汎用としては使えないので使用後は削除して下さい。

既に、プログラミングは99%完成しています。
SQL文が完成していないだけです。
Stopを使って実行直前のSQL文の列名と囲み文字を確認すればと思います。

Public Function DBLookup(ByVal strQuerySQL As String) As Variant
On Error GoTo Err_DBlookup
　　Dim dbs As DAO.Database
　　Dim rst As DAO.Recordset

　　Set dbs = DBEngine.Workspaces(0).OpenDatabase("C:\db1.mdb")
　　Set rst = dbs.OpenRecordset(strQuerySQL)
　　With rst
　　　　If Not .EOF Then
　　　　　　DBLookup = .Fields(0)
　　　　End If
　　End With
Exit_DBlookup:
On Error Resume Next
　　rst.Close
　　dbs.Close
　　Exit Function
Err_DBlookup:
　　MsgBox Err.Description
　　Resume Exit_DBlookup
End Function

補足

お世話になっています。ご指摘いただいたSQLをもう一度確認したところエラーは出なくなりましたが値を上手く抽出することができません。

[問題箇所]
Text1.Text = DBLookup("SELECT 名前 FROM Listname WHERE 日付 = '" & lblNow_date.Caption & "'")

念のため以下のように直接値を指定したら条件に基づいて値をテキストボックスへ抽出することができました。

・Text1.Text = DBLookup("SELECT 名前 FROM Listname WHERE 日付 = '2006/8/2'")

ご指摘に「ラベルコントロールは普通は使わない」
とありますがこれが原因なのでしょうか？

度々で申し訳ありませんがご回答よろしくお願い致します。

回答No.4

noname#22222

s_husky です。

これは、フーン位に！

DAOを勉強しているようですが、ADODB を使ってレコードをフォームに一気に表示することも可能です。
もちろん、取得するレコード数は１件であることが条件です。

先の DBLookup()は、幾つかのフィールドをレコード情報を基に参照する場合に使います。
レコード全体のフォームへの表示には、DisplayRecord()を使うという関係です。

フォームのテキストボックス名を field_氏名、field_生年月日、field_住所 としておけば、
呼び込んだレコード情報は、それぞれのテキストボックスに表示されます。

' -----------------------------------------------------------------------------------------
'　フォームに読み込んだ列情報を表示します。
'
'　【要件】 ファームのフィールド名が、＜"field_" ＋ 列名＞であること。
' -----------------------------------------------------------------------------------------
Public Function DisplayRecord(ByVal frm As Form, _
　　　　　　　　　　　　　　　ByVal strQuerySQL As String) As Boolean

On Error GoTo Err_DisplayRecord
　　Dim isOK As Boolean
　　Dim I　　As Integer
　　Dim N　　As Integer
　　Dim rst　As ADODB.Recordset
　　Dim fld　As ADODB.Field

　　isOK = True
　　Set rst = New ADODB.Recordset
　　rst.Open strQuerySQL, _
　　　　　　 CurrentProject.Connection, _
　　　　　　 adOpenStatic, _
　　　　　　 adLockReadOnly
　　If Not rst.BOF Then
　　　　' =================
　　　　'　Begin With: frm
　　　　' -----------------
　　　　With frm
　　　　　　N = .Controls.Count - 1
　　　　　　For Each fld In rst.Fields
　　　　　　　　For I = 0 To N
　　　　　　　　　　If Mid$(.Controls(I).Name, 7) = fld.Name Then
　　　　　　　　　　　　.Controls(I).Value = fld.Value
　　　　　　　　　　　　Exit For
　　　　　　　　　　End If
　　　　　　　　Next I
　　　　　　Next fld
　　　　End With
　　　　' ---------------
　　　　'　End With: frm
　　　　' ===============
　　Else
　　　　MsgBox " フォームに表示する情報はありません。(DisplayRecord)", vbInformation, " お知らせ"
　　End If
Exit_DisplayRecord:
On Error Resume Next
　　rst.Close
　　Set rst = Nothing
　　DisplayRecord = isOK
　　Exit Function
Err_DisplayRecord:
　　isOK = False
　　MsgBox "実行時エラーが発生しました。(DisplayRecord)" & Chr$(13) & Chr$(13) & _
　　　　　　"・Err.Description=" & Err.Description & Chr$(13) & _
　　　　　　"・SQL Text=" & strQuerySQL, _
　　　　　　vbExclamation, " 関数エラーメッセージ"
　　Resume Exit_DisplayRecord
End Function

回答No.3

noname#22222

ウーン！SQL文で苦労しているようなので、簡単にテストできる関数を・・・。

１、次のようなDBLookup()を標準モジュールに登録すると便利です。
２、Accessの DLookup()の３倍速で動作します。

[イミディエイトウィンドウ]
? DBlookup("SELECT 姓 FROM テーブル1 WHERE ID=1")
鈴木

このように [イミディエイトウィンドウ] で　SQL文　をテストできます。

(1) DBLookup()でSQL文をテストする。
(2) OKであれば、

Text1.Text = DBlookup("SELECT 名前 FROM Listname WHERE 生年月日='" & lbldate.Caption & "'")
Text3.Text = DBlookup("SELECT 住所 FROM Listname WHERE 生年月日='" & lbldate.Caption & "'")

と、２、３の列の参照程度であれば DBLookup()でも可！

注意１：ラベルコントロールは普通は使わない！
注意２：テーブル　Listname　に主キー(ID列)がない！

Option Compare Database
Option Explicit

Public Function DBLookup(ByVal strQuerySQL As String) As Variant
On Error GoTo Err_DBlookup
　　Dim dbs As DAO.Database
　　Dim rst As DAO.Recordset

　　Set dbs = CurrentDb
　　Set rst = dbs.OpenRecordset(strQuerySQL)
　　With rst
　　　　If Not .EOF Then
　　　　　　DBLookup = .Fields(0)
　　　　End If
　　End With
Exit_DBlookup:
On Error Resume Next
　　rst.Close
　　dbs.Close
　　Exit Function
Err_DBlookup:
　　MsgBox Err.Description
　　Resume Exit_DBlookup
End Function

補足

お世話になります。

アドバイスしていただいたイミディエイトウィンドウを使用しみたのですがコンパイルエラーで「Sub Functionの定義がされていない」というエラーが出ました。

またイミディエイトウィンドウを使用せずに実行してみたら以下のエラーが出ます。

[エラー内容]
オブジェクト変数、Withブロック変数が設定されていません。

[エラー箇所]
Text1.Text = DBLookup("SELECT 名前 FROM Listname WHERE 日付='" & lbldate.Caption & "'")

よろしくお願い致します。

回答No.2

nicotinism

前回のご質問の中に答えがあります。
No3で
strSQL = "SELECT * FROM Listname where 日付 = '" & lbldate"
数字は　TextBoxName
文字は　"'" & TextBoxName & "'"
日付は　"#" & TextBoxName & "#"

No2の
　　With rstMyset
　　　　.AddNew
　　　　.Fields("名前")= Text1　　'これは、rstMyset.Fields("名前")= Text1ということです
　　　　.Fields("生年月日")= CDate(Text2)
　　　　.Fields("住所")= Text3
　　　　.Update
　　End With

レコードが無い場合・・
If myset.bof and myset.eof then
　　処理
end if
とか
myset.recordcount = 0 でも判断できるかも、VBとAccessVBAでは違うかも？
ところで、レコードが複数あったときはどうするのかな？
現状では、多分最初のレコードの内容しか入らないと？

補足

お世話になっています。

アドバイスしていただいた内容だとエラーメッセージは何も出ませんでしたが抽出することができませんでした。

この質問の背景ですが現在VBでカレンダーを作成していて各日付のコマンドボタンを押すとメモ帳画面に遷移する仕組みなっています。
メモ帳には押した日付のyyyy/mm/ddがlbldateに表示されるようになっていてそのフォームにあるテキストボックスに値を入力し「登録」ボタンを押すとAccessに登録する仕組みになっています。そして画面を閉じ再度テキストボックスに入力している値の入ったメモ帳画面に遷移した時にlbldateに入っている日付をもとにAccessに登録されている値を抽出しテキストボックスに表示される機能を作りたいのです。

また
＞ところで、レコードが複数あったときはどうするのかな？現状では多分最初のレコードの内容しか入らないと？

ですが同じlbldateの値が複数ある時は最後に登録したレコードを抽出してきたいと思っています。
よろしくお願い致します。

回答No.1

kabilunlun

上手くいかないとはどのような状況でしょうか。
何かエラーメッセージは出ますか。

>※lbldateの内容は日付(テキスト型)でCaptionでとってきた値が「日付」項目に登録される。
この部分がどういう意味かちょっと分からないのですが。
lbldateのCaptionには実行時どのような値が入っているのですか。(具体的に。)

補足

お世話になっています。

>上手くいかないとはどのような状況でしょうか。
何かエラーメッセージは出ますか。

[エラー箇所]
Text1.Text = CStr(myset("名前"))

[エラー内容]
カレントレコードがありません。

>lbldateのCaptionには実行時どのような値が入っているのですか。(具体的に。)

※VBでカレンダーを作成していて各日付のコマンドボタンを押すとメモ帳画面に遷移する仕組みなっています。
メモ帳には押した日付のyyyy/mm/ddがlbldateに表示されるようになっていてそのフォームにあるテキストボックスに値を入力するとAccessに登録する仕組みになっています。そして画面を閉じ再度テキストボックスに入力している値の入ったメモ帳画面に遷移した時にlbldateに入っている日付をもとにAccessに登録されている値を抽出しテキストボックスに表示される機能を作りたいのです。
よろしくお願いします。