こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

アクセスに登録した値を条件検索により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つのテキストボックスに値を何も返さないプログラムにしたいと思っています。よろしくお願い致します。

投稿日時 - 2006-08-27 02:31:54

QNo.2364958

暇なときに回答ください

質問者が選んだベストアンサー

*****
 おまけ
*****

さて、 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()を作れば実力アップ間違いなしです。

投稿日時 - 2006-08-28 08:47:01

このQ&Aは役に立ちましたか?

1人が「このQ&Aが役に立った」と投票しています

回答(8)

ANo.7

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" で統一しないと・・・。

投稿日時 - 2006-08-28 08:14:06

お礼

お世話になっています。

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

投稿日時 - 2006-08-28 23:07:54

ANo.6

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

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

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

投稿日時 - 2006-08-27 19:26:32

ANo.5

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

投稿日時 - 2006-08-27 19:13:36

補足

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

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

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

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

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

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

投稿日時 - 2006-08-27 22:17:48

ANo.4

s_husky です。

これは、フーン位に!

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

先の 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

投稿日時 - 2006-08-27 09:42:14

ANo.3

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

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

[イミディエイトウィンドウ]
? 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 & "'")

と、2、3の列の参照程度であれば DBLookup()でも可!

注意1:ラベルコントロールは普通は使わない!
注意2:テーブル 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

投稿日時 - 2006-08-27 09:22:13

補足

お世話になります。

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

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

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

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

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

投稿日時 - 2006-08-27 18:47:36

ANo.2

前回のご質問の中に答えがあります。
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では違うかも?
ところで、レコードが複数あったときはどうするのかな?
現状では、多分最初のレコードの内容しか入らないと?

投稿日時 - 2006-08-27 03:39:47

補足

お世話になっています。

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

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

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

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

投稿日時 - 2006-08-27 17:15:58

ANo.1

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

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

投稿日時 - 2006-08-27 02:53:19

補足

お世話になっています。

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

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

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

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

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

投稿日時 - 2006-08-27 16:41:17

あなたにオススメの質問