Access2003での検索フォーム作成時の該当データ複数あった場合の処理方法

このQ&Aのポイント
  • Access2003で検索フォームを作成する際、該当データが複数あった場合の処理方法について質問です。
  • 現在、該当データが複数ある場合には、ループの中でfindnextを使用し、msgboxで次の該当データを表示させるかどうかをユーザーに確認しています。
  • しかし、msgboxが画面の真ん中に表示されるため、見づらく使い勝手が悪いです。自作のフォームを作成したのですが、そのフォームからの戻り値の受け取り方や処理の流れがわかりません。教えてください。
回答を見る
  • ベストアンサー

いつも参考にさせて頂いてます。

いつも参考にさせて頂いてます。 Access2003で検索フォームを作成しています。 find系メソッドで検索を行い、フォームに表示させるのですが 該当データが複数あった場合の処理について質問させてください。 現在、該当データが複数あった場合、ループの中でfindnextを使用し msgboxにて次の該当データを表示させるかどうかという条件分岐をしています。 ただ、この方法だとmsgboxが画面の真ん中に出てしまうので 表示されたフォームが見ずらく、使い勝手が悪いのです・・・。 そこで自分で作成したmsgboxのようなフォームを作ったのですが どのようにしてそのフォームからの戻り値を受け取るのかと 処理の流れがわかりません。 わかる方いましたら教えてください。 宜しくお願いします。 Private Sub 検索_Click() Dim db As Database Dim rs As Recordset Dim str As String Dim msg As String Set db = CurrentDb Set rs = db.OpenRecordset("取引テーブル", dbOpenDynaset) str = "取引番号='" & Me.検索 & "'" rs.FindFirst str If rs.NoMatch = False Then Me.torihikiNo.Value = rs.Fields("取引番号") Me.torihikiDay.Value = rs.Fields("取引日") Me.kokyakuName.Value = rs.Fields("顧客名") Do Until rs.EOF rs.FindNext str If rs.NoMatch = False Then msg = MsgBox("該当データが複数存在します。次を表示しますか?" _ '←ここを変更したいのです。 , vbYesNo _ , "確認") Select Case msg Case vbYes Me.torihikiNo.Value = rs.Fields("取引番号") Me.torihikiDay.Value = rs.Fields("取引日") Me.kokyakuName.Value = rs.Fields("顧客名") Case vbNo Exit Do End Select Else MsgBox "該当データはこれ以上ありません。" Exit Do End If Loop Else Me.torihikiNo.Value = vbNullString Me.torihikiDay.Value = vbNullString Me.kokyakuName.Value = vbNullString MsgBox "該当するデータはありません。" End If rs.Close Set rs = Nothing db.Close Set db = Nothing End Sub

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

  • ベストアンサー
  • myRange
  • ベストアンサー率71% (339/472)
回答No.1

●>そこで自分で作成したmsgboxのようなフォームを作ったのですが  >どのようにしてそのフォームからの戻り値を受け取るのか   標準モジュールで、Public で宣言した変数にその値をセットしておけば どのフォームからでも使えます。   以下の説明のためにその変数を、FLAG とします。     ●>処理の流れがわかりません。    現在の続行するかどうかのメッセージを表示しているところで 「続行」と「中止」のボタンのある「メッセージ用フォーム」を表示させ 「続行」のクリックで変数FLAGに「続行」の文字列セット 「中止」のクリックで変数FLAGに「中止」の文字列セット そのあと「メッセージ用フォーム」を閉じると 「検索フォーム」の次の行が実行されるので そこで、FLAGが「続行」か「中止」かを判定する    「検索フォーム」側 ------------------------------------------  メッセージ用フォームを表示(閉じると次の行が処理される)  IF FLAG = "続行" Then -------------------------------------------   それから、MSGBOXや別のフォームで確認するのではなくて、 検索フォーム自体に、「続行」、「中止」ボタンやラベルを配置して 確認のメッセージはラベルに表示してやるのも良さそうな。。。。 以上です。  

menta2000
質問者

お礼

ありがとうございます。 Publicで宣言してやってみたところ 何とか出来ました! ありがとうございました^

関連するQ&A

  • Visual Basic 2008 変数をDBへ登録するには?

    初歩的な質問ですいません。 AccessのDBへデータを登録したいのですが ラジオボタンの情報をどうやってうまく登録するか考えました。     Dim r as integer If RadioButton1.Checked = True Then r = 1        Else   RadioButton2.Checked = True r = 2 ここでラジオボタン1ならrに1を代入してちがうなら2を代入する データを追加 RS.AddNew() RS.Fields("a").Value = ComboBox1.Text RS.Fields("b").Value = ComboBox2.Text RS.Fields("c").Value = ComboBox3.Text RS.Fields("d").Value = r RS.Update() RS.Close() CN.Close() MsgBox("登録しました") End If この時、rの値をDBのdフィールドに登録したいのですが できません。 このRに入っている値を登録する方法を教えてください。 もっと簡単な方法があればそちらもご指導下さい。

  • アクセスVBA 変数での抽出条件の書きかた

    顧客データテーブルからの抽出です。 変数を使った書き方がわかりません。 よろしくお願いします。 テーブルのレコードには [氏名]:鈴木 [telnum]:0123456789 が存在します。 Private Sub テキスト0_BeforeUpdate(Cancel As Integer) Dim db As DAO.Database Dim rs As DAO.Recordset Set db = CurrentDb Set rs = db.OpenRecordset("顧客マスタ", dbOpenDynaset) Dim str As String str = "0123456789" rs.Filter = "[telnum] = ' " & str & " ' " Set rs = rs.OpenRecordset MsgBox (rs!氏名) ’←エラーメッセージ”カレントレコードがありません。”が出ます End Sub

  • Access ADP テーブル 説明欄を取得したい

    大変お世話になります。 Access 2007 ADPファイルにて SQL Server 2005 との接続でのシステムを運用しています。 テーブル情報のフィールド説明欄(Description) の値の一覧を取得したいと思い下記のプログラムを作ってみたのですが、Descriptionの値以外はおおむね取得できるのですが、説明欄のところがすべてエラーになってしまい説明欄の Description の取得ができません。 格納場所か、プロパティの参照の仕方が原因だと思うのですが、解決できません。 テーブルの説明欄(Description)値の参照の仕方をご存じの方がいらっしゃいましたら何卒ご教授いただければと存じます。 よろしくお願いいたします。     Dim Cn As ADODB.Connection     Dim Rs As New ADODB.Recordset     Dim SQL As String     Dim i As Integer          Set Cn = CurrentProject.Connection          SQL = " SELECT dbo.テーブルA.* "     SQL = SQL & " FROM dbo.テーブルA"     Dim MyDB As New ADOX.Catalog     Dim MyTable As ADOX.Table     Dim MyField As ADOX.Column     MyDB.ActiveConnection = CurrentProject.Connection     Set MyTable = MyDB.Tables("テーブルA")          Rs.Open SQL, Cn, adOpenForwardOnly, adLockReadOnly         For i = 0 To Rs.Fields.Count - 1             MsgBox Rs.Fields(i).Name                                     'MsgBox MyTable.Columns(Rs.Fields(j).Name).Properties("Description").Value             MsgBox Rs.Fields(i).Properties("Description").Value             MsgBox Rs.Fields(i).ActualSize             MsgBox Rs.Fields(i).Attributes             'MsgBox Rs.Fields(i).DataFormat             MsgBox Rs.Fields(i).DefinedSize             MsgBox Rs.Fields(i).NumericScale             'MsgBox Rs.Fields(i).OriginalValue             MsgBox Rs.Fields(i).Precision                          'MsgBox Rs.Fields(i).Properties("Description")                                      MsgBox Rs.Fields(i).Status             MsgBox Rs.Fields(i).Type             'MsgBox Rs.Fields(i).UnderlyingValue             MsgBox Rs.Fields(i).Value                  Next     Set MyDB = Nothing     Rs.Close     Set Rs = Nothing     Cn.Close     Set Cn = Nothing     Exit Sub

  • カレント行取得

    Do While Not rs.EOF  If Text1(0).Text <> rs.Fields(1) Then   /*--*--*/   rs.MoveNext     Else   msg = "コードが重複しています."   MsgBox msg, vbOKOnly, "重複チェック"   Text1(0).Text = ""   Text1(0).SetFocus  End If Loop *------ text1(1) = rs.fields(1) text1(2) = rs.fields(2) -------* データベース(Access)にデータが3件入っていて、例えば、1件目のデータを更新したいのですが今のソースでは、/*--*--*/でデータベースを次々読んでいるので、3件読み終えたときにカレント行が4件目にあると思うので、それを”任意”の行にしたいのですが教えてください。

  • ACCESS どこがおかしいのか?

    ACCESSで。クエリからフォームを作成し、検索フォームを作成しようとしています。 AND条件とOR条件を作り検索(抽出)を行いたいのですが、何が間違っているのか、 検索をかけるとすべて「登録がありません」になってしまいます。 どこが間違っているのか、もしくは代替案を教えていただけますでしょうか。 以下は記述した、VBAコードです。 Private Sub 検索ボタン_Click() Dim db As DAO.Database Dim rs As DAO.Recordset Dim stFil As String Set db = CurrentDb() Set rs = db.OpenRecordset("Q_Autoweb", dbOpenDynaset) 'オプションボタンで条件を選択 If 検索条件 = 1 Then rs.Filter = "[タイトル]='" & タイトル検索 & "' and [本文]='" & テキスト15 & "'" Else rs.Filter = "[タイトル]='" & タイトル検索 & "' or [本文]='" & テキスト15 & "'" End If Set rs = rs.OpenRecordset Set Me.Recordset = rs If rs.EOF = True Then MsgBox "登録がありません" Else Me.ID = rs!ID Me.案件名 = rs!案件名 Me.タイトル = rs!タイトル Me.本文 = rs!本文 End If rs.Close Set rs = Nothing db.Close Set db = Nothing End Sub よろしくお願いします。

  • フォームが見えなくなっちゃう

    フォームに、コマンドがあって、それをクリックすると終了確認が出るようにしました。 Dim MSG as integer MSG = msgbox("終了しますか?",vbYesNo,"確認") If MSG = 6 then end end if ちゃんと終了はできるのですが、Msgboxが出ている時にフォームが表示されないんです。キャンセルすると再び見えるんですが、どうすれば直るでしょうか。

  • Accessで、DAOでAddnew

    参照はDAOで、Addnewでデータの追加をしたいのですが、記述が悪いのか、上手くできません。 どなたか、教えて下さい! テーブル:スケジュールソース フィールド:日付 Private Cur_Db As DAO.Connection Private rs As DAO.Recordset Private sql As String Dim str_date As String str_date = Me!日付 Set Cur_Db = CurrentDb rs.Open "スケジュールソース", Cur_Db, dOpenKeyset, adLockOptimistic rs.AddNew rs("日付").Value = str_date rs.Update

  • Access 重複しないメールをテーブルに取り込む

    参考サイトのサンプルをマネしながら少しだけ改造して、OutLookのメールをAccessのテーブル"tbl_mail"に取り込むVBAを書いてみました。 一度取り込んだメールは二度と取り込まない仕組みなのですが、実行してみると必ず1通だけ重複したメールを取り込んでしまいます。 対象フォルダは「個人用フォルダ」の中の「受信トレイ」の中の「集荷」です。 サンプルとして3通のメールを入れていますが、何度実行しても、 "新しいメールはありませんでした。"とはならずに、 "読込み1件・重複2件"となります。 最近ADOを勉強し始めたばかりで原因がさっぱりわかりません。 このサンプルに対する質問は検索してもほとんど見つけられませんでした。 よろしくお願いいたします。 Access2010(Win7)で作り、DBはUSBに保存して、Access2007(vista)でも使っています。 フォームのボタンで標準モジュールのFunction MailGetoを呼び出して実行しています。 Function MailGeto() On Error GoTo エラー Dim cn As ADODB.Connection Dim rs As ADODB.Recordset Dim myNaSp As NameSpace Dim myFolder As MAPIFolder Dim mySecFolder As MAPIFolder Dim myThrFolder As MAPIFolder Dim myItem As MailItem Dim myindex As Long, x As Long, y As Long, i As Long, r As Long Dim MyCri As String Set cn = Application.CurrentProject.Connection Set rs = New ADODB.Recordset rs.Open "tbl_mail", cn, adOpenKeyset, adLockOptimistic Set myNaSp = GetNamespace("MAPI") Set myFolder = myNaSp.GetDefaultFolder(olFolderInbox) i = 0: r = 0 For x = 1 To myFolder.Folders.Count Set mySecFolder = myFolder.Folders(x) For myindex = 1 To mySecFolder.Items.Count Set myItem = mySecFolder.Items(myindex) '受信日時と件名をつなげた文字列を一意とする MyCri = myItem.ReceivedTime & myItem.Subject '条件…"tbl_mail"テーブルの"KEY"フールドの値と一致するもの rs.Find "KEY='" & MyCri & "'" If rs.EOF Then '検索条件と合致する物がない場合 rs.AddNew rs!Key.Value = MyCri rs.Fields("フォルダー").Value = mySecFolder rs.Fields("受信日").Value = myItem.ReceivedTime rs.Fields("送信者").Value = myItem.SenderName rs.Fields("件名").Value = myItem.Subject rs.Fields("メール").Value = myItem.SenderEmailAddress rs.Fields("内容").Value = myItem.Body rs.Update i = i + 1 'メール件数を求めます。 Else r = r + 1 End If Next Next If i = 0 Then MsgBox "新しいメールはありませんでした。" Else MsgBox "メールの更新が完了しました。" & Chr(13) & Chr(13) & _ "・読込み " & i & "件" & Chr(13) & _ "・重複 " & r & "件" End If rs.Close cn.Close Exit Function エラー: If Err.Number = 287 Then MsgBox "書き出しを中止しました" Else MsgBox Err.Number & Err.Description MsgBox "予期せぬエラーが発生しました" End If End Function

  • フォーム上のフィルタで抽出されたデータをテーブルに格納したい

    フォーム上のフィルタで抽出されたデータをテーブルに格納したい 度々お世話になります。 フォーム上で3つのキーワードを使って抽出したデータを テーブルに格納したいと思っています。 以下のコードを書いたところ、矢印の部分でエラーが起こります。 お知恵を拝借できませんでしょうか? よろしくお願いいたします。 Private Sub cmd04_Click() Dim db As DAO.Database Set db = CurrentDb() Dim mySQL As String mySQL = "INSERT INTO 04_パソコン機器管理台帳 select * FROM T05_使用者一覧抽出結果 WHERE " & Me.Filter & ";" If MsgBox("該当レコードを追加します。", vbYesNo) = vbYes Then ' SQLを実行します。 db.Execute mySQL   ←エラーが発生します。 MsgBox "該当レコードを追加しました。" End If End Sub

  • ACCESSの SELECT SUM

    SELECT SUMを 計算させると ゼロしか 出てきません。 どこが悪いのでしょうか?  日付         出金       氏名 2012/12/10      540      安田 2012/12/10      1020      斉藤 2012/12/10       970      TOM 2012/12/11      650      池田  2012/12/11     2010      南 2012/12/12      350      林田 2012/12/12     1200      加藤 のようなテーブルがあり Private Sub コマンド_click() Dim Db As Database Dim SQL As String Dim rs As Recordset Dim gokei As Long Set Db = CurrentDb SQL = "SELECT Sum(出金) as gokei FROM テーブル  WHERE 日付= #" & [Forms]![フォームアルファ]![テキスト] & "# " Set rs = Db.OpenRecordset(SQL) MsgBox gokei End Sub を フォームアルファに 新しく作ったコマンドボタンのクリック時に 書きました。 これを テキストの日付を変えておいて いろいろ試しても ゼロのメッセージしか出ません。 WHERE以下が 間違っていないか 試しに Private Sub コマンド_click() Dim Db As Database Dim SQL As String Dim rs As Recordset Dim Count As Long Set Db = CurrentDb SQL = "SELECT (出金)  FROM テーブル  WHERE 日付= #" & [Forms]![フォームアルファ]![テキスト] & "# " Set rs = Db.OpenRecordset(SQL) If rs.EOF Then Count = 0 Else rs.MoveLast Count = rs.RecordCount End If MsgBox Count End Sub を 実行すると ちゃんと 正しいレコード数が 表示されます。 「出金」のデータ型は 長整数になっています。 どこが 悪いのでしょうか? 目的は 指定した日付の 出金の合計を取り出したいのです。 . . .

専門家に質問してみよう