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

このQ&Aのポイント
  • Excel VBAを使用して、Accessのデータを効果的に検索する方法を学びましょう。
  • 除外テーブルの管理IDを使って、指定のデータを検索することができます。
  • VBAのコードを使用して、データベースの接続と検索を行いましょう。
回答を見る
  • ベストアンサー

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

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

  • ベストアンサー
  • nda23
  • ベストアンサー率54% (777/1415)
回答No.1

考え方が全然違います。 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すれば良いでしょう。

xcode_15
質問者

補足

ご回答を戴きまして、誠に有難うございます。 この方法ですと、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 わかる方はご指示ください。 よろしくお願いします。

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

    こんばんは。 お世話になります。 エクセルVBAにてアクセスからデータを取得し、その一部をロックしたいです。 (取得方法には色々あるかと思います。 経験が浅いためどう表現すれば適切か自信がありませんが 「ADOコネクションオブジェクトとADOレコードセットオブジェクトにて実施しています。」) 【VBAの仕様の説明】 「読込」ボタンを押すと、B12~AA1000のエリアのデータを一掃して、 そこに条件によりレコード数が変わりますが、アクセスのデータをセットしています。 その後、これらの出力されたレコードについてエクセル上にて値を書き換えたのちに 「更新」ボタンを押すと、アクセスに更新に行くというものです。 このときB,C,D,E列については、更新処理時に重要なものであり、F列以降と異なり 書き換えてはいけないものです。 【実現したいこと】 このエクセルを開いてから閉じるまでの間、いつでもB12~E1000は手入力不可にしたいです。 ただし、エクセルを開いていきなりロックをしてしまうと、「読込」を押したときに アクセスのデータを出力するときにエラーになってしまいますので 読込ボタンを押した後はB12~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~)のフルパス '---------ファイルが開けない場合のエラーを追加 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ファイル(~2003)を開く adoCn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DBpath & ";" 'Accessファイル(2007~)を開く '---------ファイルが開けない場合のエラーを追加 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 & "%' " '~を含む 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!~~~ ~中略~ Cells(i, 26) = adoRs!~~~ 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

  • 可変の検索条件件数で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 色々と調べてみたものの、解決する気配がせず、どなたか知恵をお貸しください。

  • 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 /------------------------------------------------/

  • ExcelからAccessデータの抽出

    部署内の機器管理にExcelを使用しています、今回レコード数がExcelでは対応できなくなりデータのみAccessに置いといてデータ処理はExcelマクロで行おうと思っています。 そのAccessファイルからある日付(または期間○日~△日まで等)岳のレコードを抽出したいと思っています。 ネットや書籍でいろいろ調べたのですがうまく抽出できません(SQL文がおかしいと思います)。ご教授お願いします(Access・SQLは全くの素人です) テーブル名は『4』です Sub Macro3() Dim objDB As New ADODB.Connection Dim RS As New ADODB.Recordset objDB.Open _ "Provider=Microsoft.Jet.OLEDB.4.0;" & _ "Data Source=" & "C:\aaa.mdb" With RS .ActiveConnection = objDB .Source = "SELECT * from 4 WHERE 日付<2009/04/15" .Open End With Range("A3").CopyFromRecordset RS objDB.Close Set objDB = Nothing End Sub

  • Excel VBA について教えて下さい

    Excel VBA でAccess接続します 今までは Sub aaa() Set cn = CreateObject("ADODB.Connection") cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=aaa.mdb;" End Sub のように使っていましたが(単一プロシージャ) Set cn = CreateObject("ADODB.Connection") の部分をパブリックにして Sub bbb() cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=aaa.mdb;" End Sub 別のプロシージャからも、使えるためには パブリックにするための方法を教えて下さい

  • VBでAccessにSQL文を実行して値を取り出す

    下記のソースは、 UserIDとPasswordをDBと照らし合わせて、 そのUserが存在すればTrue、存在しなければFalse を返すというプログラムです。 しかし初めてDBに接続し、まったく右も左も分からない 状況なので処理的におかしな点を教えていただけないでしょうか。 またDB接続からSQL実行までの簡単な流れを教えていただけると助かります。 adoRs = ADODB.Recordset adoCn = ADODB.Connection adoCd = ADODB.Command Login.txtName.Text = 比較するユーザー名 Login.txtPass.Text = 比較するパスワード です。その他わかりにくい点があったら質問を お願いします。 Private Function Func_UserSerch() As Boolean Func_UserSerch = False On Error GoTo UserSerchError 'レコードセットの取得 With adoRs .ActiveConnection = adoCn .Source = "user" .CursorType = adOpenStatic .LockType = adOpenForwardOnly .Properties("IRowsetIdentity") = True .Open End With MySQL = "SELECT * FROM user " & _ "WHERE UserID = " & Login.txtName.Text & _ "AND Password = " & Login.txtPass.Text & ";" 'SQLの実行 With adoCd .ActiveConnection = adoCn .CommandType = adCmdStoreProc .CommandText = MySQL .Execute End With If adoRs.EOF = True And adoRs.BOF = True Then Func_UserSerch = False Else Func_UserSerch = True End If UserSerchError: MsgBox "SQL実行中にエラーが発生しました" End Function

  • 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のバージョンではエラーなく動作します。 間違っている点をご指南いただければと思います。 よろしくお願いいたします。

  • PostgresのViewをExcelのVBAでレコード取得できない

    はじめまして。mady1234と申します。 Postgresを利用した社内ツールを作成しています。 Postgresのテーブルからレコード取得は出来ますが、Viewからの取得が出来ません。エラーが発生します。 実行時エラー'-2147467259(8004005)': 環境はサーバーはVine4.2 Postgres8.3 クライアントのOSはXP Excelは2003です。 色々と検索しましたが、テーブルのレコード取得の方法はあってもビューは見つけれませんでした。 ご教授の程、宜しくお願いいたします。 --------------------------以下、VBAの記述です-------------------  Dim row1,col1, as integer row1=1 col1=1 Dim adoCON As New ADODB.Connection Dim adoRS As ADODB.Recordset Set adoCON = New ADODB.Connection adoCON.CommandTimeout = 0 adoCON.ConnectionString = "DSN=PostgreSQL30;" & _ "uid=postgres;" & _ "pwd=;" adoCON.Open Set adoRS = New ADODB.Recordset adoRS.Source = " SELECT * from View1;" adoRS.ActiveConnection = adoCON adoRS.CursorType = adOpenKeyset adoRS.LockType = adLockOptimistic adoRS.Open Do Until adoRS.EOF Worksheets("sheet1").Cells(row1, col1).Value = adoRS!usuryou adoRS.MoveNext row1 = row1 + 1 Loop adoRS.Close adoCON.Close Set adoRS = Nothing Set adoCON = Nothing

  • エクセルVBAでアクセスのテーブルを操作

    アクセスのテーブルを名前を変えて保存したいのですが、エラー「2486:アクションを実行出来ない。」のメッセージが発生してしまいます。 構文は、以下の通りです。 Sub test() Dim ACC As Object Dim ACCC As ADODB.Connection Dim ACCR As ADODB.Recordset Dim SQL As String Set ACC = Access.Application Set ACCC = New ADODB.Connection Set ACCR = New ADODB.Recordset Const ACCpath = "D:\DB.mdb" SQL = "SELECT * FROM [dammy]" '接続し開く ACCC.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & ACCpath ACCR.Open SQL, ACCC, adOpenStatic, adLockOptimistic ACCR.MoveFirst If ACCR.Fields("日付").Value < DateSerial(Year(Now), 1, 1) Then ACC.DoCmd.CopyObject , "dammy(" & Year(Now) - 1 & "年)", acTable, "dammy" ACC.DoCmd.RunSQL "DELETE [dammy].* FROM [dammy];" End If End Sub エラー発生箇所は、IF文の中です。 対処方法を教えて下さい。 宜しくお願いします。

専門家に質問してみよう