• ベストアンサー
  • すぐに回答を!

Excel VBA : Accessのデータを検索

Excel VBA を使って、Accessのデータを検索したい。 除外テーブルには「管理ID」レコードが在り、ユニークな番号を登録してあります。 やりたいことは、除外テーブルの管理IDに在るであろう、"E003"の有無を確認したいと思います。 作ってみたソースコードは、以下の通り。 Private Sub aSearch_Click() DB.TableOpen ("db_name.mdb") 'Accessのファイル DB.FindRecode ("E003")  ' 検索対象文字列 DB.TableClose End Sub ------------------------------ここから、標準モジュール Public adoCn As ADODB.Connection Public adoRs As ADODB.Recordset Public fSql As String Public fRow As Integer 'データ ソースへの接続と、レコードセットへの接続 Sub TableOpen(ByVal mdb_name As String) Set adoCn = New ADODB.Connection 'データ ソースへの接続 adoCn.Provider = "Microsoft.Jet.OLEDB.4.0" 'Accessへ接続プロバイダ名 adoCn.Open mdb_name '接続するmdbファイル名" fSql = "select 管理ID from 除外テーブル" Set adoRs = New ADODB.Recordset 'レコードセットへの接続 adoRs.Open fSql, adoCn, adOpenKeyset, adLockReadOnly 'クエリーの実行 ' adoRs.Open "除外テーブル", adoCn, adOpenKeyset, adLockReadOnly 'クエリーの実行 End Sub 'レコード(管理ID)の検索 Function FindRecode(ByVal findName As String) As String adoRs.Find adoRs.Fields("管理ID") & "=" & findName     '← ここでエラーとなる  If adoRs.RecordCount = 0 Then MsgBox "該当するレコードは存在しません" FindRecode = "" Exit Function Else Do     ' Doループは、要らないかも??? Debug.Print adoRs.Fields("管理ID") & "/" & adoRs.Fields("登録日") adoRs.MoveNext Loop Until adoRs.EOF End If FindRecode = adoRs.Fields("管理ID") End Function 'データ ソースへの接続と、レコードセットを切断する Sub TableClose() adoRs.Close 'クエリーを閉じる adoCn.Close 'データ接続を閉じる Set adoRs = Nothing Set adoCn = Nothing End Sub ------------- ここまで データのソースから、検索する方法が良く判っておらず、Open / find の使い方はこれで良いのでしょうか。 以上、よろしくお願いします。

共感・応援の気持ちを伝えよう!

  • 回答数1
  • 閲覧数791
  • ありがとう数0

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

  • ベストアンサー
  • 回答No.1
  • nda23
  • ベストアンサー率55% (773/1384)

考え方が全然違います。 Findでは探す条件を指定するのです。 例えば"管理ID='111'"のような指定になります。 >adoRs.Find adoRs.Fields("管理ID") & "=" & findName これだと、レコードセットの管理IDが左辺になってしまい、 "E003=E003"のような文字列になります。しかも、 管理IDが数値なら良いですが、文字列なので引用符で 囲む必要があります。 それと「あるなし」を調べるだけならFindは使わない方が 良いでしょう。つまり、SQLを次のようにします。 fSql = "select 管理ID from 除外テーブル" fSql = fSql & " where 管理ID='" & findName & "'" これでレコードセットを作り、EOFプロパティを見ます。 Trueなら該当レコードが無く、Falseなら該当レコードが あります。その後Closeすれば良いでしょう。

共感・感謝の気持ちを伝えよう!

質問者からの補足

ご回答を戴きまして、誠に有難うございます。 この方法ですと、adoRs.EOFにデータの有無を調べるだけで、"E003"を調べません。 "S003"と入力をして、Trueになるはず(データには存在しません)がFalseになってしまいます。 つまり、Do - Loop で該当する"E003"の確認をすることになるのでしょうか? Function FindRecode(ByVal findName As String) As String fSql = fSql & " where 管理ID='" & findName & "'" 'レコードセット If adoRs.EOF = True Then MsgBox "該当するレコードは存在しません" FindRecode = "" Exit Function Else MsgBox "該当するレコードを、発見!!" Do Debug.Print adoRs.Fields("管理ID") adoRs.MoveNext Loop Until adoRs.EOF End If FindRecode = adoRs.Fields("管理ID") End Function 私の解釈が間違っていたら、指摘してください。

関連するQ&A

  • vbaで、postgresqlアクセス問題

    vbaで、postgresqlアクセス問題:      データベースに、データは ***0000, でも、vbaで、取得したのは ****.四つの0が自動に、削除されました。      例: postgresqlに、 40000 ⇒ vbaで、取得した: 4   vbaソース:  Option Explicit Sub subPgGetData() Dim adoCn As New ADODB.Connection On Error GoTo ErrLogin: With adoCn .Provider = "PostgreSQL OLE DB Provider" .Properties("Data Source") = Range("B1").Value .Properties("Location") = Range("B2").Value .Properties("User ID") = Range("B3").Value .Properties("Password") = Range("B4").Value .Open End With On Error GoTo 0 Dim adoRs As New ADODB.Recordset On Error GoTo ErrSql: adoRs.Open Range("B6").Value, adoCn, adOpenForwardOnly, adLockReadOnly On Error GoTo 0 Workbooks.Add Cells.CopyFromRecordset adoRs Cells.Columns.AutoFit adoRs.Close: Set adoRs = Nothing adoCn.Close: Set adoCn = Nothing Exit Sub ErrLogin: MsgBox "" & vbCrLf & Err.Number & vbCrLf & Err.Description Set adoCn = Nothing Exit Sub ErrSql: MsgBox "" & vbCrLf & Err.Number & vbCrLf & Err.Description Set adoRs = Nothing adoCn.Close: Set adoCn = Nothing Exit Sub End Sub わかる方はご指示ください。 よろしくお願いします。

  • 可変の検索条件件数でAccessデータを抽出

    http://okwave.jp/qa/q8790348.html ここで質問をさせて頂いたのですが 私の質問方法が下手で、違う意味合いになっていましたので再度投稿させてください。 ■ やりたい事 ADOを用いて、Accessのテーブル内のフィールドに「指定の数値」がある場合 その行を全てExcelに抽出したい ■ 特徴 「指定の数値」は複数あり、なおかつ可変。  → VBAで作成したコンボボックス(Accessから読込)にて選択し、F45から下に好きな個数だけ追加 ■ つまづき点 「指定の数値」全てを検索対象に(OR検索)して SQLのSelect文で取得しようとしてもやり方が分からない ■ 現在のコード '宣言 Private adoCn As Object Private adoRs As Object Private strSQL As String Private Const DBpath = "\Access.mde" Sub DBconnect(flg As Boolean) 'DB呼出 Set adoCn = CreateObject("ADODB.Connection") If flg = True Then Set adoRs = CreateObject("ADODB.Recordset") adoCn.Open "Provider=Microsoft.jet.OLEDB.4.0;Data Source=" & DBpath & ";" End Sub Sub 対象() Dim tmpFldCnt As Variant Dim tmpRecCnt As Integer Dim buf() As Variant Call DBconnect(True) m = Worksheets("選択").Range("B47") Dim i As Long Dim j As Long i = 45 j = 44 + Worksheets("選択").Range("B47") 'B47:コンボボックスで選んだ個数分の数値 On Error GoTo err_hander adoCn.BeginTrans 'トランザクション処理開始 strSQL = _ "select * from TBL where コード = [選択$F" & i & ":F" & j & "]" 'F45より下に取得した値が入っていく adoRs.Open strSQL, adoCn, adOpenKeyset 'SQLを実行して、対象をadoRsへ tmpFldCnt = adoRs.Fields.Count tmpRecCnt = adoRs.RecordCount Range("M28:DG31").ClearContents ReDim buf(tmpFldCnt - 1, tmpRecCnt - 1) buf = adoRs.GetRows Range(Cells(28, 13), Cells(28 + tmpFldCnt - 1, 13 + tmpRecCnt - 1)) = buf adoCn.CommitTrans 'トランザクション終了 Call DBcut_off(True) 'DB切断呼び出し Exit Sub 色々と調べてみたものの、解決する気配がせず、どなたか知恵をお貸しください。

  • ExcelVBAでAccessのデータを検索する

    Excel  VBA で、ADOを用いてAccess のデータを検索するにはどうしたらいいですか。 やりたいこと 検索結果を、Excel のセルにコピーすること。 ソースコード 'MDBファイルに接続します Set db = New ADODB.Connection db.Provider = "Microsoft.Jet.OLEDB.4.0" db.Open "C:\Database\test.mdb" 'レコードセットを開きます Set rs = New ADODB.Recordset 'テーブルを開きます rs.Open "PT_MST", db, adOpenForwardOnly, adLockReadOnly findName = ws.Cells(i, 1) & ws.Cells(i, 2) Do ' rs.Find "[S_NUM]='" & findName & "'" rs.Find rs.Fields(1).name & " Like '20k%'"  ← ここで、サポートしていない旨のエラーが出る。 If Not (rs.EOF) Then Debug.Print rs.Fields(1).Value Else Exit Do End If rs.MoveNext Loop Until rs.EOF '閉じる rs.Close db.Close '終了処理 Set rs = Nothing Set db = Nothing どう直したら、検出結果を取得できますか。 ご教示下さい。

  • エクセル ADO Filterでは一気に削除はできないのですか?

    カテ違いならすいません。 Tメインテーブルの番号フィールド(主キーではない為重複がある)に該当の番号があればそのレコードを削除するアクセスVBAを考えているのですが行き詰っています。 Public ADOrs As ADODB.Recordset Public cn As ADODB.Connection **************************************************** Sub 削除1() Set cn = New ADODB.Connection cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & CurrentProject.Name 番号 = Forms("フォーム1").Controls("番号").Value Set ADOrs = New ADODB.Recordset ADOrs.Open "SELECT * FROM Tメイン", cn, adOpenKeyset, adLockOptimistic ADOrs.Filter = "番号 = '" & 番号 & "'" ADOrs.Delete ADOrs.Update ADOrs.Close: Set ADOrs = Nothing cn.Close: Set cn = Nothing End Sub **************************************************** ↑これで もし、Tメインの番号フィールドに該当の番号が3レコート゛あれば全部一気にDelete出来るわけではないのですか? 一気にフィルタにかかっているレコードを削除できると思ってたのですが1レコート゛ずつのようです。 しかし **************************************************** Sub 削除2() Set cn = New ADODB.Connection cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & CurrentProject.Name 番号 = Forms("フォーム1").Controls("番号").Value Set ADOrs = New ADODB.Recordset ADOrs.Open "SELECT * FROM Tメイン", cn, adOpenKeyset, adLockOptimistic ADOrs.Filter = "番号 = '" & 番号 & "'" Do While ADOrs.RecordCount <> 0 'あるなら ADOrs.Delete ADOrs.Update '保存 Loop ADOrs.Close: Set ADOrs = Nothing cn.Close: Set cn = Nothing End Sub **************************************************** としたら 実行時エラー '-2147217887 (80040e21)': 複数ステップの OLE DB の操作でエラーが発生しました。各 OLE DB の状態の値を確認してください。作業は終了しませんでした。 のエラーになりました。 なので、 **************************************************** Sub 削除3() Set cn = New ADODB.Connection cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & CurrentProject.Name 番号 = Forms("フォーム1").Controls("番号").Value Set ADOrs = New ADODB.Recordset ADOrs.Open "SELECT * FROM Tメイン", cn, adOpenKeyset, adLockOptimistic ADOrs.Filter = "番号 = '" & 番号 & "'" Do While ADOrs.RecordCount <> 0 'あるなら ADOrs.Delete ADOrs.Update '保存 ADOrs.Close: Set ADOrs = Nothing Set ADOrs = New ADODB.Recordset ADOrs.Open "SELECT * FROM Tメイン", cn, adOpenKeyset, adLockOptimistic ADOrs.Filter = "番号 = '" & 番号 & "'" Loop ADOrs.Close: Set ADOrs = Nothing cn.Close: Set cn = Nothing End Sub **************************************************** と言うように1レコートずつまわしていくしかないのでしょうか? 削除3はプログラムとして少し変かな?と思うのですが どうでしょう? よろしくお願いします。

  • ADO Connection を再利用する方法

    【環境】 OS:Windows Server 2003 DB:SQL Server 2005 言語:VB .NET 2005 現在、Windows2000Server + SQLServer2000 + VB6の環境を 上記の環境に移行しております。 ADO Connectionの再利用で 「手動または分散トランザクションモードのため、新規接続を作成できません」 というエラーが発生します。 いろいろと検索してみたのですが、解決せず、お力をお貸しいただきたいと思って投稿させていただきます。 現在のコードは、 -------------------------------------------- Public adoCn As ADODB.Connection Public adoRs As ADODB.Recordset Public Sub pfAutoClosed()  If fGet印刷ジャーナルファイルRecordset() = True Then    '*********************    'トランザクションの開始    '*********************    adoCn.BeginTrans()    '印刷ジャーナルファイルのロック    sMySQL = "SELECT * FROM 印刷ジャーナルファイル WITH (TABLOCKX)"    adoCn.Execute(sMySQL, , ADODB.CommandTypeEnum.adCmdText)    '職員表マスタのロック    sMySQL = "SELECT * FROM 職員表マスタ WITH (TABLOCKX)"    adoCn.Execute(sMySQL, , ADODB.CommandTypeEnum.adCmdText) <---- ここでエラー発生    adoRs.MoveFirst()    Do Until adoRs.EOF      iKubun = nz(adoRs.Fields("区分").Value)      '*****************      '1.職員表マスタの作成      '*****************      'SQLステートメントを作成      sMySQL = "INSERT INTO 職員表マスタ (~以下省略)"      adoCn.Execute(sMySQL, , ADODB.CommandTypeEnum.adCmdText)      '**************************      '2.更新区分に更新フラグを設定      '**************************      sMySQL = "UPDATE 印刷ジャーナルファイル " & "SET 更新区分 = 1 (~以下省略)"      adoCn.Execute(sMySQL, , ADODB.CommandTypeEnum.adCmdText)      adoRs.MoveNext()    Loop    adoCn.CommitTrans() 'トランザクション処理のコミット    adoRs.Close()    adoRs = Nothing  endif End Sub '***************************************** '印刷ジャーナルファイルのレコードセットを取得 '***************************************** Private Function fGet印刷ジャーナルファイルRecordset() As Boolean   adoRs = New ADODB.Recordset   With adoRs     .let_Source("SELECT * FROM 印刷ジャーナルファイル " & "WHERE 発行区分 = 1 AND 更新区分 = 0")     .let_ActiveConnection(adoCn)     .CursorType = ADODB.CursorTypeEnum.adOpenKeyset     .LockType = ADODB.LockTypeEnum.adLockPessimistic     .Open()   End With   If adoRs.EOF Then     fGet印刷ジャーナルファイルRecordset = False   Else     fGet印刷ジャーナルファイルRecordset = True   End If End Function -------------------------------------------- となっています。 pfAutoClosed関数内で、同じadoCnを使用しての2度目のSELECT文が実行できません。 ADO Connectionの再利用ができないということで、「Close」をしてくださいという記述を参考にもしたのですが、解決しておりません。 トランザクション開始位置も変更してみたのですが、だめでした。 VB->VB.NETへのアップグレードウィザードを使用したのですが、移行以前のVB6のバージョンではエラーなく動作します。 間違っている点をご指南いただければと思います。 よろしくお願いいたします。

  • ACCESS VBA

    ACCESSで検索フォームを作りたいと思っています。 VBAを使って行きたいと思うのですが、うまくいきません。 希望としては、該当するレコードのデータを抽出したいです。 よろしくお願いいたします。 ※現段階でのソースを書いてみました。 最終的に行いたい処理とは違うのですが、根本的に間違っているようなので簡略化しました。 /------------------------------------------------/ Private Sub コマンド1_Click() Dim cn As ADODB.Connection Dim rs As ADODB.Recordset Dim sql As String '接続 Set cn = CurrentProject.Connection 'レコードセットを取得 Set rs = New ADODB.Recordset sql = "SELECT * FROM 従業員データ " & _ "WHERE 年齢=30" rs.Open sql, cn, adOpenDynamic, adLockReadOnly rs.Close: Set rs = Nothing cn.Close: Set cn = Nothing End Sub /------------------------------------------------/

  • Driver={Microsoft Access

    アクセス2007です。 Sub test() Dim cn As New ADODB.Connection Dim rs As New ADODB.Recordset Dim MyFile As String MyFile = "C:\test.accdb" cn.Open "Driver={Microsoft Access Driver (*.mdb)}; DBQ=D:\" & MyFile & ";" rs.Open "SELECT * FROM テーブル1", cn MsgBox "テーブルに接続出来ました。" rs.Close: Set rs = Nothing cn.Close: Set cn = Nothing End Sub ********************************************************* を実行しても実行時エラーになります。 cn.Open "Driver={Microsoft Access Driver (*.mdb)}; DBQ=D:\" & MyFile & ";" を cn.Open "Provider = Microsoft.ACE.OLEDB.12.0;" & "Data Source= " & MyFile に変えればうまくいきますが なぜ、"Driver={Microsoft Access Driver (*.mdb)}; DBQ=D:\"じゃダメなのでしょうか? 教えてくださいませ。

  • VBA データセットした後にその一部をLOCK

    こんばんは。 お世話になります。 エクセルVBAにてアクセスからデータを取得し、その一部をロックしたいです。 (取得方法には色々あるかと思います。 経験が浅いためどう表現すれば適切か自信がありませんが 「ADOコネクションオブジェクトとADOレコードセットオブジェクトにて実施しています。」) 【VBAの仕様の説明】 「読込」ボタンを押すと、B12&#65374;AA1000のエリアのデータを一掃して、 そこに条件によりレコード数が変わりますが、アクセスのデータをセットしています。 その後、これらの出力されたレコードについてエクセル上にて値を書き換えたのちに 「更新」ボタンを押すと、アクセスに更新に行くというものです。 このときB,C,D,E列については、更新処理時に重要なものであり、F列以降と異なり 書き換えてはいけないものです。 【実現したいこと】 このエクセルを開いてから閉じるまでの間、いつでもB12&#65374;E1000は手入力不可にしたいです。 ただし、エクセルを開いていきなりロックをしてしまうと、「読込」を押したときに アクセスのデータを出力するときにエラーになってしまいますので 読込ボタンを押した後はB12&#65374;E1000のロックを外したいです。 これが難しいようであれば、エクセルを開いてから「読込」を押すまでの間は ロックをかけなくてもよいです。 ある程度ググったので シートを保護する & 特定のセルのLOCKをfalseにする を適切なタイミングで 実施するのだとは理解していますが、実装しようとすると 「RangeクラスのLockedプロパティを設定できません」というエラーが出てしまって 詰まってしまっています。 よろしくお願いいたします。 ↓↓↓↓ソースです。↓↓↓↓ Private adoCn As Object 'ADOコネクションオブジェクト Private adoRs As Object 'ADOレコードセットオブジェクト Private strSQL As String 'SQL文 Private Const DBpath As String = "C:\zaiko.accdb" '接続するファイル(2007&#65374;)のフルパス '---------ファイルが開けない場合のエラーを追加 Private file_error As String '--------- Sub DBconnect(flg As Boolean) 'DB接続プロシージャ '---------ファイルが開けない場合のエラーを追加 On Error GoTo Err_Handler 'エラーが起きたら"Err_Handler"へ file_error = 0 'エラーが起きない正常な間はエラーをオフにする。 '--------- Set adoCn = CreateObject("ADODB.Connection") 'ADOコネクションオブジェクトを作成 If flg = True Then Set adoRs = CreateObject("ADODB.Recordset") 'ADOレコードセットオブジェクトを作成 'adoCn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & DBpath & ";" 'Accessファイル(&#65374;2003)を開く adoCn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DBpath & ";" 'Accessファイル(2007&#65374;)を開く '---------ファイルが開けない場合のエラーを追加 Exit Sub '正常ならここで終了 Err_Handler: 'エラーが起きたらここへ飛ぶ MsgBox "「C:\」フォルダの下にエクセルとアクセスファイルを置いてください。" file_error = 1 '--------- End Sub Sub DBcut_off(flg As Boolean) 'DB切断プロシージャ If flg = True Then adoRs.Close 'レコードセットのクローズ adoCn.Close 'コネクションのクローズ Set adoRs = Nothing 'オブジェクトの破棄 Set adoCn = Nothing End Sub Sub DBread() '読み込み Dim shouhinbangou As String, dy As String, txt As String Call DBconnect(True) 'DB接続 If file_error = 1 Then file_eroor = 0 '初期化してから Exit Sub '処理終了 End If With UserForm1 .show 'ユーザーフォーム表示 If .TextBox1 = "" Then '商品番号欄が空欄の場合 shouhinbangou = "" Else '商品番号欄が記入済 shouhinbangou = "WHERE item_no LIKE '%" & .TextBox1 & "%' " '&#65374;を含む End If End With strSQL = _ "SELECT * " & _ "FROM zaiko_table " & _ shouhinbangou adoRs.Open strSQL, adoCn 'SQLを実行して対象をRecordSetへ Range("B12:Z1000").ClearContents '前のデータクリア Range("B12:Z1000").Font.ColorIndex = xlAutomatic 'フォント色を初期化 Range("B12:AA1000").Borders.LineStyle = xlLineStyleNone Application.EnableEvents = False 'イベントオフ(ワークシートチェンジが反応しないように) i = 12 'スタート行 Do Until adoRs.EOF 'レコードセットが終了するまで処理を繰り返す Cells(i, 2) = adoRs!ID Cells(i, 3) = adoRs!item_no Cells(i, 4) = adoRs!color_no Cells(i, 5) = adoRs!item_name Cells(i, 6) = adoRs!&#65374;&#65374;&#65374; &#65374;中略&#65374; Cells(i, 26) = adoRs!&#65374;&#65374;&#65374; i = i + 1 '行をカウントアップする adoRs.MoveNext '次のレコードに移動する Loop '下から数える With Range("B12") .Resize(Cells(Rows.Count, .Column).End(xlUp).Row - .Row + 1, 26).Borders.LineStyle = xlContinuous End With Application.EnableEvents = True 'イベントオン Call DBcut_off(True) 'DB切断 End Sub

  • SQLの条件に変数を

    はじめまして。よろしくお願いします select文のwhere条件にidを指定したいのですがうまくいきません。 べつに変数を使用しなくてもよいのですが良い方法がありましたらご教授下さい Private Sub コマンド8_Click() Dim adoCON As ADODB.Connection Dim adoRS As ADODB.Recordset Dim no As interger no=me.id Set adoCON = Application.CurrentProject.Connection Set adoRS=adoCON.Execute("select varcodeno from varcode_tbl where id=no")strName = adoRS!varcodeno adoRS.Close adoCON.Close Set adoRS = Nothing Set adoCON = Nothing Me.jancode.Value = strName End Sub

  • Access VBA について

    Access2000 をXPで動かしています。 全く別のフォルダーに入れている ABC.mdb を使って、 \Seikyu というフォルダーにある 請求sys.mdb の テーブル「銀行マスター」から銀行名等を取りだそう としています。 Dim DB As ADODB.Connection Set DB = New ADODB.Connection DB.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=C:\Program Files\Seikyu\請求sys.mdb;" Set RS = New ADODB.Recordset RS.Open "銀行マスター", DB, adOpenKeyset, adLockOptimistic Me.T1 = RS!ID Me.T2 = RS!銀行名 Me.T3 = RS!口座 RS.Close DB.Close こうすると、 実行時エラー '3709': このコンテキストで閉じられているかあるいは無効です のエラーが表示されます。 どこが間違いなのでしょうか。