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

このQ&Aのポイント
  • Excel VBAを使用してADOを介してAccessのデータを検索する方法について教えてください。検索結果をExcelのセルにコピーしたいです。
  • Excel VBAでAccessのデータを検索する際の手順をお教えください。検索結果をExcelのセルにコピーしたいです。
  • Excel VBAを使ってAccessのデータを検索する方法について教えてください。Excelのセルに検索結果をコピーしたいです。
回答を見る
  • ベストアンサー

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 どう直したら、検出結果を取得できますか。 ご教示下さい。

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

  • ベストアンサー
  • ShowMeHow
  • ベストアンサー率28% (1424/5027)
回答No.1

よくわかんないけど、オイラだったら、 findName = ws.Cells(i, 1) & ws.Cells(i, 2) strSQL = "SELECT * FROM PT_MST WHERE S_NUM ='" & findName & "' and FieldName** like '20k%'" rs.Open "SELECT * FROM PT_MST WHERE S_NUM ='" ", db, adOpenForwardOnly, adLockReadOnly do if rs.eof then exit do debug.print rs.Fields(1).Value rst.movenext Loop のように、対象レコードでレコードセットを作るかな。 FieldName** は実際のフィールドネームを使ってください。 

xcode_15
質問者

お礼

ありがとうございます。 結果として次のコードにしました。 'テーブルを開きます findName = ws.Cells(i, 1) & ws.Cells(i, 3) strSQL = "SELECT * FROM PT_MST WHERE S_NUM ='" & findName & "'" rs.Open strSQL, db, adOpenForwardOnly, adLockReadOnly Do If rs.EOF Then Exit Do Debug.Print rs.Fields(1).Value rs.MoveNext Loop

その他の回答 (3)

  • Siegrune
  • ベストアンサー率35% (316/895)
回答No.4

http://msdn.microsoft.com/ja-jp/library/cc364156.aspx より引用。 <引用1> 注意 Find メソッドを呼び出す前にカレント行の位置が設定されていない場合は、エラーが発生します。Find メソッドを呼び出す前に、MoveFirst などの、行の位置を設定するメソッドを呼び出す必要があります。 <引用2> 比較演算子に "like" を使用する場合、文字列値にアスタリスク (*) を含めると、1 つまたは複数の文字または部分文字列を検索することができます。 <引用おわり> まず、<引用1>に対応できていません。 Do loopの処理をする前に rs.MoveFirst するとどうなりますか? また、<引用2>を参照してほしいのですが、 rs.Find rs.Fields(1).name & " Like '20k%'" は、%がエラーになっているか、「20k%」という文字列を探すだけになります。 (ADOのFILTERと違って、ADOのFINDでは、%は、部分文字列を検索する意図では使えないはず。) rs.Open "PT_MST", ・・・ は、JETでaccessのデータベースを参照しているので select * from PT_MST と同じ動きをしたと思います。 ## なんで、Findを使おうとしているか分りませんので、あえてお薦めはしませんが、 ## Find使うよりFilter使ったほうが、それより、 ## rs.Open でselect文を書いたほうがより使いやすいと思いますが。

xcode_15
質問者

お礼

ありがとうございます。 参考にさせて頂きました。

回答No.3

>rs.Open "PT_MST", db, adOpenForwardOnly, adLockReadOnly の"PT_MST"の部分には SQL が入るべきなので、この文がエラーしていそう。 なので、 rs オブジェクトが作成されてないと思われる。 その結果 >rs.Find rs.Fields(1).name & " Like '20k%'"  の rs.Fields(1).name が無効と言われているのではないかな? 他の回答にもあるように do_loop の前に select を投げて、 そのあと、do_loop の中で結果を順に読んでいく様にすべきですね。

xcode_15
質問者

お礼

ありがとうございます。 >do_loop の前に select を投げて、 >そのあと、do_loop の中で結果を順に読んでいく様にすべきですね。 知らなかった。 勉強になりました。 (゜゜)(。。)ペコッ

  • ShowMeHow
  • ベストアンサー率28% (1424/5027)
回答No.2

ゴメン、 rs.Open strSQL, db, adOpenForwardOnly, adLockReadOnly だった。

関連するQ&A

  • Access ADOについて質問です。

    Access ADOについて質問です。 以下コードでレコードセットを返す関数を使用しています。 動作的には問題ないのですが、標準モジュール内のレコードセットをClose及びNothingしていないのが気になります。 Private Sub Form_Open(Cancel As Integer) Dim rs2 As ADODB.Recordset Set rs2 = New ADODB.Recordset Set rs2 = CreateRecordSet("SELECT * FROM T_Standard;") Set Me.Recordset = rs2 rs2.Close: Set rs2 = Nothing end sub '標準モジュール Public Function CreateRecordSet(strSQL As String) As ADODB.Recordset Dim cn As ADODB.Connection Dim rs As ADODB.Recordset Set cn = New ADODB.Connection cn.ConnectionString = "provider=Microsoft.Jet.OLEDB.4.0;" _ & "Data Source=O:\標準DB\StandardBackEnd.mdb" cn.Open Set rs = New ADODB.Recordset rs.Open strSQL, cn, adOpenStatic, adLockReadOnly Set CreateRecordSet = rs ' rs.Close: Set rs = Nothing   ←この部分 ' cn.Close: Set cn = Nothing   ←この部分 End Function 標準モジュール内ではCloseやNothingしなくてもメモリの開放は行われているのでしょうか? アドバイスよろしくお願いいたします。

  • ACCESS ADOのMovePreviousについて

    毎度お世話になっております。 ACCESS2003を使用しています。 ACCESS ADOにて、レコードセットがeofになった後、 MovePreviousをし、MoveNextをし、 さらにもう一度MovePreviousをすると、 最終レコードの一つ前に戻ってしまいます。 テーブル1 フィールド1 フィールド2    1     あ    2     い    3     う    4     え    5     お コード Sub test()   Dim cn As New ADODB.Connection   Dim rs As New ADODB.Recordset   Set cn = CurrentProject.Connection   rs.Open "select * from テーブル1 order by フィールド1", cn, adOpenDynamic, adLockReadOnly   Do Until rs.EOF    rs.MoveNext   Loop   rs.MovePrevious   Debug.Print rs.Fields("フィールド1").Value   rs.MoveNext   rs.MovePrevious   Debug.Print rs.Fields("フィールド1").Value   rs.Close: Set rs = Nothing   cn.Close: Set cn = Nothing End Sub 一度目のdebug.printは5に、 二度目のdebug.printは4になります。 このような仕組みなのでしょうか。 ご教授お願いいたします。

  • 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 の使い方はこれで良いのでしょうか。 以上、よろしくお願いします。

  • 二つのMDBファイルの間のデータのやり取り

    おせわになります。みなさんの知恵を貸してください。 いかがシステム構成です。 A.mdb(テーブル:Work1) B.mdb(テーブル:Work2) A.mdbはカレントデータベースです。B.mdbはDSN=KANRIで アクセスしたいです。 現在Work1のデータをWork2に追加したいのですが、どのような方法が考えられますか? ちなみに以下のコードを書いてみました。 -------------------------------------------------- Dim cn1 As New ADODB.Connection, cn2 As New ADODB.Connection Dim rs1 As New ADODB.Recordset, rs2 As New ADODB.Connection Dim com As New ADODB.Command, mysql As String Set cn1 = CurrentProject.Connection cn2.ConnectionString = "provider=MSDASQL;DSN=KANRI" mysql = "insert into Work2 select * from Work1" com.activeconnection = cn2 com.commandtext = mysql com.Execute Set com = Nothing rs1.Close: Set rs1 = Nothing rs2.Close: Set rs2 = Nothing cn1.Close: Set cn1 = Nothing cn2.Close: Set ch2 = Nothing -------------------------------------------------- Work1は見当たらないとエラーが出ました。 どなたか教えてください。 rs1.EoF Loop をまわしながら一行ずつ追加するしかないでしょうか?

  • 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': このコンテキストで閉じられているかあるいは無効です のエラーが表示されます。 どこが間違いなのでしょうか。

  • Access クエリ抽出結果をExcel(特定フォーム)に出力させたい

    いつもいつもお世話になっております(><) 今までこちらで色々質問しながら、 「条件入力フォームで入力した条件で、レコードを条件抽出し、この抽出結果をフォームに出力、かつ、伝票発行する」 というシステムを作っています。 今、伝票発行の部分で、下記のようなプロシージャを組みました。 そして、下記★(コード内参照)の2点で詰まっています。 ★1 指定しているクエリは抽出結果のフォームなのですが、これが「SQLステートメントが正しくありません」となります。どうしてでしょうか。ちなみに実在する別のクエリ名にすると、一応動きます。 ★2 フォーム上に抽出されたレコードがEOFになるまで、というループ条件にしたいのですが、この部分の記述は正しいでしょうか。 いつも初心者的質問で恐縮です。 どうぞよろしくお願い致します。 --------------------------------------------- Option Compare Database Private Sub 伝票発行_Click() Dim db As ADODB.Connection Dim rs As ADODB.Recordset Dim app As Object Dim wb As Excel.Workbook Dim iRow As Long Dim iColm As Long '■初期化 iRow = 12 iColm = 1 '■確認 If MsgBox("伝票を出力します。", vbOKCancel) = vbOK Then '■DBコネクション Set db = CurrentProject.Connection '■レコードセットの取得 Set rs = New ADODB.Recordset rs.Open "受注集計クエリ_f", db, adOpenStatic, adLockReadOnly '★1 '■Excelアプリの起動及びファイルオープン Set app = CreateObject("Excel.Application") app.Workbooks.Open filename:=CurrentProject.Path & "\nouhinsyo.xls" '■Excelシート名指定 app.Worksheets(1).Select Do Until rs.EOF '★2 ws.Cells(iRow, iColm + 2) = rs("品番") ws.Cells(iRow, iColm + 3) = rs("商品名") ws.Cells(iRow, iColm + 4) = rs("受注数の合計") ws.Cells(iRow, iColm + 8) = rs("備考") rs.MoveNext iRow = iRow + 1 Loop MsgBox "発行完了。" End If rs.Close app.Quit 'エクセルセッションをクローズする。 Set ws = Nothing '変数の初期化 Set wb = Nothing '変数の初期化 Set app = Nothing '変数の初期化 Set db = Nothing End Sub

  • access ふたつのテーブル間でのデータ移動VB

    win10 office365 accessのテーブルの table1のフィールド IDの数値を table2のフィールド ID (いずれも長整数型 数値型 重複あり 空白の許容なし) にコピーする操作ですが 幾度か お尋ねしてきていますが 今回 このやり方で やってみました http://www.mahoutsukaino.com/ac/ac2002/vba/vba16/v16.htm 以下のコードにおいて rs2.Update ここの部分が黄色くなって とまってしまいます しかし なぜか 数値の移行は 出来ていました ただ止まってしまうと 次に続けられなく困っています Public Function table2table1() Dim cn As adodb.Connection Dim rs1 As adodb.Recordset Dim rs2 As adodb.Recordset Set cn = Application.CurrentProject.Connection Set rs1 = New adodb.Recordset Set rs2 = New adodb.Recordset rs1.Open "table1", cn, adOpenStatic, adLockReadOnly rs2.Open "table2", cn, adOpenKeyset, adLockOptimistic rs1.MoveFirst Do Until rs1.EOF rs2.Find "ID='" & rs1!ID & "'" If rs2.EOF Then rs2.AddNew rs2![ID] = rs1![ID] rs2.Update End If rs1.movenext Loop rs1.Close rs2.Close cn.Close End Function 以上 すみません 宜しくお願い致します

  • セレクトしたデータを更新させるにはどうしたらよろしいのでしょうか?

    更新されません。 セレクトしたデータをそのまま更新させようとしているからいけないのでしょうか? <% Dim DB,Rs,Cmd Set DB = Server.createobject("ADODB.Connection") On error Resume Next DB.open "mysql" DB.BeginTrans Set Cmd=Server.createobject("ADODB.command") Cmd.activeconnection=db Cmd.commandtext="select * from stb where id =1" Set Rs = Cmd.Execute i=cint(1) j="ADSL" Do until Rs.eof Rs("id"),value= i Rs("name").value= j Rs.update If DB.Errors.Count >0 then DB.Rollbacktrans response.write "エラー" for idx = 0 to 2 Response.write db.errors(idx).Description & "<br>" next else DB.commitTrans response.write "データが登録されました。" end if Rs.movenext Loop Rs.close DB.close set Cmd = Nothing set Rs = Nothing set db = Nothing %>

  • EXCEL vbaからACCESSのクエリを開く

    EXCEL2010 WEBを参照してEXCEL VBAでACCESSのクエリを開くマクロを流用しました。 下記がマクロの内容です。 Private Sub Import() Dim db As ADODB.Connection Dim rs As ADODB.Recordset 'ACCDBファイルに接続します Set db = New ADODB.Connection db.Provider = "Microsoft.Ace.OLEDB.12.0" db.Open "C:\work\TEHAI.accdb" 'レコードセットを開きます Set rs = New ADODB.Recordset 'Accessのクエリを開く rs.Open Source:="TEHAI", ActiveConnection:=db If rs.EOF Then MsgBox "抽出した結果、レコードが見つかりません。" Else ' レコードをシートへ貼り付ける Range("A1").CopyFromRecordset rs End If rs.Close Set rs = Nothing Set db = Nothing End Sub これを実行すると、 抽出した結果、レコードが見つかりません。 が表示されます。 ACCESS単体でTEHAIクエリを実行したら、約3万件くらいヒットします。 EXCELマクロから実行したらACCESSからデータをもってこられません。 なぜレコードが見つかりません、 となるのでしょうか? マクロのどこがおかしいのか、教えていただきたく。 ちなみに、もともとの内容から変更したのは db.Open "C:\work\TEHAI.accdb" rs.Open Source:="TEHAI", の2ヶ所だけです。

  • EXCELVBAでADOにてデータ更新(削除)がうまくいかない。

    EXCELファイル(DB.XLS)とEXCELファイル(入力.XLS)を用意し、入力.XLSからデータベース.XLSへ更新処理を行いたいのですが削除処理がうまくいきません。 現状はADOにて表示、追加、修正、削除をしようと考えており下記記述(1)で削除処理を書いているのですが「クエリーが複雑すぎます。」エラーが発生しています。 又、別削除処理としてDim MYCMD As ADODB.CommandからMYCMD.CommandText = "DELETE FROM [データベース$] WHERE 日付 = " & Range("D4")でMYCMD.Executeしても行削除ができません。 これはhttp://support.microsoft.com/default.aspx?scid=kb;ja;257819にも記載があるように仕様なのかもしれませんが・・・ ただ、Worksheets("データベース").Rows(2).Deleteのように同一のブック内にデータベースがあれば削除可能でした。 別ファイル(DB.xls)の行削除はできないのでしょうか?特にADOでなくてもかまいませんが、できるだけOS側の設定は手動設定させたくないです。 OS:WindwsXP SP2 ソフト:Microsoft Excel2003 ※表示(select)、追加(.AddNew)は下記記述(1)と少し異なりますが可能でした。 ''入力.XLSの記述(1) ''**********削除処理2 ADO[Microsoft.Jet.OLEDB.4.0] クエリーが複雑すぎますのエラー Dim strCn As String Dim cn As ADODB.Connection Dim rs As ADODB.Recordset Dim test_sql As String strCn = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ "Data Source=" & ThisWorkbook.Path & "\DB.xls;" & _ "Extended Properties=Excel 8.0" Set cn = New ADODB.Connection cn.Open strCn Set rs = New ADODB.RecordsetEXCEL With rs .CursorLocation = adUseClient .Open "Select * from [データベース$]", cn, adOpenStatic, adLockOptimistic Do test_sql = "日付 = " & Range("D4") rs.Find test_sql If rs.EOF = True Then Exit Do rs.Delete 'ここでエラー Loop .Update .Close End With Set rs = Nothing cn.Close Set cn = Nothing ''***********

専門家に質問してみよう