DAO 条件に一致するレコードを取得(Findメソッド)
※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。
※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。
Sub DAO_Find_Record() '*********************************************** 'DAO 条件に一致するレコードを取得(Findメソッド) '*********************************************** '[Microsoft DAO 3.6 Object Library]参照設定 Dim objDtbs As DAO.Database Dim objRcrd As DAO.Recordset Dim strTblName As String Dim strFilePath As String Dim strFileName As String Dim strFindFieldName As String Dim strMatchFieldName(4) As String Dim strSeek As String Dim strSQL As String Dim strMSG As String strFilePath = ThisWorkbook.Path 'ファイルのパス strFileName = "KEN_ALL.mdb" 'ファイル名 strTblName = "KEN_ALL" 'テーブル名 strFindFieldName = "フィールド3" '検索フィールド名 strMatchFieldName(1) = "フィールド3" '検索結果フィールド名 strMatchFieldName(2) = "フィールド7" '検索結果フィールド名 strMatchFieldName(3) = "フィールド8" '検索結果フィールド名 strMatchFieldName(4) = "フィールド9" '検索結果フィールド名 strSeek = "0600008" '検索文字 '【エラートラップ】 On Error GoTo ThisERR: '【データベースを開く】 Set objDtbs = OpenDatabase(strFilePath & "\" & strFileName) '【指定テーブルのレコード取得】 Set objRcrd = objDtbs.OpenRecordset(strTblName) objRcrd.FindFirst strFindFieldName & "=" & "'" & strSeek & "'" If objRcrd.NoMatch = False Then strMSG = objRcrd.Fields(strMatchFieldName(1)) & vbCr strMSG = strMSG & objRcrd.Fields(strMatchFieldName(2)) & vbCr strMSG = strMSG & objRcrd.Fields(strMatchFieldName(3)) & vbCr strMSG = strMSG & objRcrd.Fields(strMatchFieldName(4)) MsgBox strMSG, 0, strSeek Else MsgBox "見つかりません", 0, strSeek End If '-------------------------------------------------------------- 'メソッド | 開始位置 | 検索方向 | 用途 '---------------|-----------|-----------|----------------- 'FindFirst | 先頭 | 終端 | カレント 'FindLast | 終端 | 先頭 | カレント 'FindNext | カレント | 終端 | 複数存在 'FindPrevious | カレント | 先頭 | 複数存在 '---------------|-----------|-----------|----------------- 'プロパティ | 検索成功 | 検索失敗 | '---------------|-----------|-----------|----------------- 'NoMatch | False | True | '---------------|-----------|-----------|----------------- '演算子 | =,<,>,<=,>= '-------------------------------------------------------------- '【レコードを閉じる】 objRcrd.Close '【データベースを閉じる】 objDtbs.Close ' 【オブジェクト解放】 Set objRcrd = Nothing Set objDtbs = Nothing Exit Sub '【エラートラップ】 ThisERR: MsgBox "予期せぬエラーが発生しました。" & vbCrLf & Err.Description, vbCritical, "ErrNumber:" & Err.Number End Sub |