DAOを使ってACCESSのテーブルを全READして全データをEXCELに表示する方法

このQ&Aのポイント
  • 初心者でも簡単にできるDAOを使って、ACCESSのテーブルを全READして全データをEXCELに表示する方法を紹介します。
  • ボタン1をクリックすると、指定したデータをACCESSに追加する機能を実装する際に、既存のレコードと重複する場合には追加させないロジックを組み込む方法を解説します。
  • ボタン1をクリックした時に、追加されるデータがテーブル1の一番下に追加されるようにする方法を紹介します。現在は中途半端な位置に追加されてしまう問題を解決します。
回答を見る
  • ベストアンサー

DAOでACCESSをREADしてEXCELに表示

お世話になります。 初心者ですが、DAOを使ってACCESSのテーブル(名称”テーブル1”)を全READして全データをEXCELに表示するところまでは出来ました。 (やりたいこと1) 今度は下記の様に"ボタン1"をクリックされたら、Accessに下記の様なデータ(今は"taro"という固定でデータですが将来的には可変的する予定です)を追加したいのですが、既にAccess側に社員番号と氏名が同じレコードがあった場合には追加させないロジックを追加したいのです (やりたいこと2) "ボタン1"をクリックした時に、追加される"taro"のデータはAccessの"テーブル1"の一番下に追加されるようにしたいです。現在は中途半端にテーブル1の真ん中あたりに追加されます。 上記2点につきまして、どなたかご教授いただけませんでしょうか? よろしくお願い致します。 環境 Windows XP SP3 Excel2003 Sub ボタン1_Click() Dim rst As DAO.Recordset Dim fld As DAO.Field Dim sht As Worksheet Dim rcnt As Long, ccnt As Long '行カウンタ、列カウンタ ' On Error GoTo Err_DAOSample If DBE Is Nothing Then Set DBE = New DAO.DBEngine End If If DB Is Nothing Then Set DB = DBE.OpenDatabase("C:\TEST.mdb") End If Set rst = DB.OpenRecordset("SELECT * FROM テーブル1", dbOpenDynaset) Set sht = ActiveSheet ' レコード追加 With rst .AddNew .Fields("社員番号") = "00000010" .Fields("氏名") = "taro" .Fields("所属") = "管理部" .Fields("年齢") = 19 .Update End With End Sub

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

  • ベストアンサー
  • tsubuyuki
  • ベストアンサー率45% (699/1545)
回答No.2

> テーブルへのデータの2重登録を防ぐロジックについて 質問本件と「まったく違う」案件ですので、詳細は新たに質問を立ててくださいね。 ごく単純に解決しようと思ったら2パターンでしょうね。 1)アクセスでテーブルの構造を工夫する   ⇒ご自身で書いていらっしゃる「キーを設定して」のキーを「主キー」に設定、    あるいは「重複無しインデックス」を付ける 2)エクセルでコードを工夫する   ⇒つまり、AddNewする前に、「キー」の重複が無いかチェックする    全てのレコードを読み、「キー」が既に存在していたら弾く まぁ、恐らくですが、前者が簡単です。

yakkun2338
質問者

お礼

tsubuyuki様、ご連絡ありがとうございました。 またご連絡が遅くなりまして大変申し訳ございませんでした。 (1)アクセスでテーブルの構造を工夫する で実施しようと思います! この度は本当にありがとうございました!m(_ _)m

その他の回答 (1)

  • tsubuyuki
  • ベストアンサー率45% (699/1545)
回答No.1

なかなか回答がつかないようですので、私が知り得る範囲で。 とりあえず結論から先に行ってしまうと「今のままでは無理」です。 おそらく、アクセス(などのDB・DBMソフト)における 「レコードの順番」について勘違いなさっているようです。 アクセスはエクセル(などの表計算ソフト)と違い、 「このレコードは何番(行)目」という、セルの概念を持ち合わせていません。 アクセスでは新規レコードが追加されると、記録媒体などの空き領域に レコード単位で(ほぼ)ランダムに記録・蓄積していき、 記録媒体などから発見した順に表示します。 ですので、必ずしも「登録したレコード順に並ぶ」とは限らないのです。 そこでユーザー(開発者含む)が「並べ替え(ソート)」という機能を使って、 好みの順番で画面に表示させる必要が出てくるのです。 レコードを好みの順に並べ替え(ソート)するためには「キー」が必要です。 添付図を見る限り 「追加された“taro”レコードを末尾に持って行く」 ためのキー項目(ソートキー)が見当たりません。 [社員番号]・[氏名]をキーにすると先頭に来てしまいますし、 [所属]をキーにしてやると中途半端な位置に持って行かれます。 [年齢]もキーとしては役に立たないようです。 よって「今のままでは無理」なのです。 どうしても「追加された“taro”レコード」を末尾に表示する必要があるなら、 (まったく無駄なフィールドではありますが)[登録順]などの 「キーに成り得るフィールド」を持っておく必要があります。 ・DCount関数などで全体の件数を取り、+1して登録順を見る ・DMax関数でキー項目の最大値を求め、+1して最新データとする ・オートナンバー型のフィールドを追加して、それを登録順として使う ・[登録日]フィールドを追加し、これをキーに使う などの手段が考えられます。 ですが(おそらく)普通は「社員番号」は入社順に割り当てられるものだと思いますので、 「新規レコード」に「一番若い社員番号」を持って行くこと自体に疑問は残りますが・・ 設計・設定次第ではこれがそのままソートキーフィールドに使えるモノだと思います。 参考までにお納めくださいませ。

yakkun2338
質問者

補足

tsubuyuki様、ご連絡ありがとうございます! ご教授いただきました概念、大変参考になりました。 本当にありがとうございます。 初心者の私にも分かるようなご丁寧なご解説もありがとうございます。 キーを設定して新たにテーブルを作り直すことにします。 あと、テーブルへのデータの2重登録を防ぐロジックについてご教授いただけますと幸いでございます。 よろしくお願い致します。

関連するQ&A

  • DAOでテーブルを作成

    DAOでテーブルを作成したいのですが 主キーにしてオートナンバー型にするにはどうすればいいですか? Sub MyTableCreate() Dim db As DAO.Database Dim tbdef As DAO.TableDef Dim Field1 As DAO.Field Dim Field2 As DAO.Field Set db = CurrentDb Set tbdef = db.CreateTableDef("T_test") Set Field1 = tbdef.CreateField("ID", dbInteger) Set Field2 = tbdef.CreateField("氏名", dbText, 20) tbdef.Fields.Append Field1 tbdef.Fields.Append Field2 db.TableDefs.Append tbdef db.Close: Set db = Nothing End Sub これで、IDフィールドを主キーにしつつ、 dbIntegerではなくオートナンバー型にしつつ、 主キーを付与する方法を教えてください。 DAOのType プロパティのヘルプを見たのですがありませんでした。 今回は http://www.accessclub.jp/dao/20.html を参考にしました。

  • VB2008からAccess2007へのDAO接続でエラーになります。

    VB2008からAccess2007へのDAO接続でエラーになります。 VB2008EEからDAO3.6を利用し、Access2007(*.accdb)に接続しようとしていますが、 エラーが発生してしまい、接続できません。 エラーの内容は下記のとおりです。 実行時エラー '3343': データベースの形式 'XXX' を認識できません。 Access2000のデータベース(*.mdb)には普通に接続できています。 Accessのバージョンを問わずに接続したい場合、どうすればよいのでしょうか? 参考までに現在のコードを記載しておきます。 ※DAO3.6に参照設定してあります。 Imports dao Module modConnectDb Public Function DaoConnect(ByVal strDb As String) As Boolean 'strDb:データベースのファイルパス Dim Ws As dao.Workspace Dim DbE As dao.DBEngine Dim Db As dao.Database Dim strMsg As String Try DbE = New dao.DBEngine Ws = DbE.Workspaces(0) Db = Ws.OpenDatabase(strDb) Catch ex As Exception strMsg = "エラー番号 " & Str(Err.Number) & vbCrLf & _ Err.Source & " でエラーが発生しました。" & vbCrLf & Err.Description MsgBox(strMsg, vbExclamation, "エラー") End Try End Function End Module

  • 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 2000 の VB での テーブル作成について質問です。

    下記のようにAccess 2000のVBからDAOを使ってテーブルを作っておりますが、 作るフィールドに規定値の設定もVBからできないのでしょうか?DAOだと無理なのでしょぅか? 教えてください Dim db As DAO.Database Dim tbdef As DAO.TableDef Dim flID As DAO.Field Set db = CurrentDb Set tbdef = db.CreateTableDef("テーブル") Set flID = tbdef.CreateField("ID", dbInteger)   tbdef.Fields.Append flID   db.TableDefs.Append tbdef db.Close: Set db = Nothing

  • アクセス2000VBA DAOをADOに書き換えてください

    アクセス2000VBA DAOをADOに書き換えてください 下記プログラムをADOに書き換えてください。(DAT1、DAT2はモジュールにて定義してあります) Option Compare Database Dim DBS As Database Dim QDF As QueryDef Dim RST As DAO.Recordset Dim COUNT1 Private Sub Form_Load() On Error Resume Next DAT2 = [Forms]![伝票]![HAKKOU1] Set DBS = CurrentDb Set QDF = DBS.QueryDefs("発行") With QDF .Parameters("DAT1") = DAT2 ’もしかしたら DAT2 ではエラーがでるかもしれません。 Set RST = .OpenRecordset() ’正しい記述を教えてください .Close End With With RST COUNT1 = !指示書 .Close End With

  • ACCESS 処理件数の取得

    更新した件数を取ろうとしています。 下記のような処理をしている場合どう値をとればいいのでしょうか? rst.RecodCountでとろうとしたらテーブル内の件数(?)が取れてしまったようなのですが・・・ Dim rst As DAO.Recordset rst.Fields(1) = rstWork.Fields(1) rst.Update

  • ExcelからAccess2013DBを更新する時

    Excel2013 vba-> Access2013 mdbファイル 問題点:以下のソースを実行すると、エラーが発生します。このエラーをなくしてアクセスデータベースのテーブルの情報の更新、新規追加、削除を行いたいです。 エラー内容:実行時エラー'3251' 現在のRecordsetは更新をサポートしていません。プロバイダーか、選択されたロックタイプの限界の可能性があります。 ソース: Sub 登録処理()   Dim Rst As adodb.Recordset   Dim SQL As String   Dim Rg As Range   Dim RgData As Range   Dim lngLastRow As Long   Dim RgDel As Range      On Error GoTo errH      Set RgData = mySh.Range("B2")   lngLastRow = RgData.End(xlDown).Row   Set RgData = mySh.Range(RgData, mySh.Range("AB" & lngLastRow))      SQL = "Select * from [会社管理テーブル]"   Call DBconection2   Set Rst = New adodb.Recordset   With Rst     .ActiveConnection = Cn     'SQL文でテーブル名と抽出条件を指定する     .Source = SQL     .CursorLocation = 3 ' クライアントサイドカーソルに変更     .Open        End With      Dim y As Long      Sheets("会社管理").Select      If Rst.EOF = False And Rst.BOF = False Then          For i = 1 To RgData.Rows.Count              If Cells(i + 1, 1).Value = "変更" Then         Rst.MoveFirst         Rst.Find "[施工会社ID]=" & RgData(i, 1).Value         If Rst.EOF Then                    Else           Rst.Fields("会社ID").Value = RgData(i, 2).Value           Rst.Fields("会社名").Value = RgData(i, 3).Value           Rst.Fields("フリガナ").Value = RgData(i, 4).Value              Rst.Update         End If         Cells(i + 1, 1).Value = ""       ElseIf Range(i, 1).Value = "削除" Then         Rst.MoveFirst                  Rst.Find "[会社ID]=" & RgData.Cells(i, 1).Value         If Rst.EOF Then                    Else           Rst.Delete         End If         Set RgDel = Rows(i + 1 & ":" & i + 1)         RgDel.Select         RgDel.Delete                ElseIf Range(i, 1).Value = "新規" Then         Rst.AddNew         Rst.Fields("会社ID").Value = RgData(i, 2).Value         Rst.Fields("会社名").Value = RgData(i, 3).Value         Rst.Fields("フリガナ").Value = RgData(i, 4).Value         Rst.Update         Cells(i + 1, 1).Value = ""       End If            Next i        End If exitH:      Rst.Close: Set Rst = Nothing   Call DBclose2   Exit Sub         errH:   MsgBox Err.Number & "(" & Err.Description & ")"   GoTo exitH    End Sub Sub DBconection2()   Set Cn = New adodb.Connection   Cn.Provider = "Microsoft.Jet.OLEDB.4.0"   Cn.Open modPublic.DBPATH    End Sub Function MakeDBconection() As adodb.Connection   Set Cn = New adodb.Connection   Cn.Provider = "Microsoft.Jet.OLEDB.4.0"   Cn.Open modPublic.DBPATH      Set MakeDBconection = Cn    End Function Sub DBclose2()   Cn.Close   Set Cn = Nothing End Sub Sub EraseContents(s_Rg As Range)   s_Rg.ClearContents    End Sub 誰か、解決方法がおわかりの方がいましたら、アドバイスをよろしくお願いします。

  • アクセス テーブルデータ他のテーブルにコピーVBA

    win10 access365のmdbファイルにおいて table1のフィールド1がID 数値型 長整数型 値要求あり 重複あり フィールド2が氏名 短いテキスト型 225 値要求なし 重複あり  table2;フィールド1がID 数値型 長整数型 値要求あり 重複あり フィールド2が氏名 短いテキスト型 225 値要求なし 重複あり  上記に置いて table2の新しいデータとして table1のデータをコピーしたい、 ただしtable1には レコードは1行だけとします (table1にレコードが複数行ある場合の最新レコードだけtable2にコピーも出来れば知りたいです) アクセス付属の更新クエリーでは、どうも うまくいきません sqlにおいて UPDATE table1, table2 SET table2.ID = [table1]![ID], table2.氏名 = [table1]![氏名]; 上記動作しません Function table1から2() Dim db As DAO.Database Dim rst As Recordset Dim TB As Table Dim Rdset As Recordset On Error Resume Next Set db = DBEngine(0)(0) Set Rdset = db.OpenRecordset("table2", DB_OPEN_TABLE) Rdset.AddNew Rdset![ID] = Table![table1]![ID] Rdset![氏名] = Table![table1]![氏名] Rdset.Update End Function table1, table2を それぞれ 同名のフォームを作り Function table1から2() Dim db As DAO.Database Dim rst As Recordset Dim fm As Form Dim Rdset As Recordset On Error Resume Next Set db = DBEngine(0)(0) Set fm = Forms![table1] If Rdset.BOF Then Exit Function Else Set Rdset = db.OpenRecordset("table2", DB_OPEN_TABLE) Rdset.AddNew Rdset![ID] = Forms![table1]![ID] Rdset![氏名] = Forms![table1]![氏名] Rdset.Update End If End Function いずれも table2のデータ更新が なされていません すみません 宜しくお願い致します

  • Access :ALTER TABLE で作成した文字列フィールドがトリミングされない

    いつもお世話になっております。 Access2000を使用しております。 Accessで作成した、あるシステムのバージョンアップを行っております。 その際、複数のテーブルにフィールドを追加する移行プログラムを作成しております。 Dim DB As DAO.Database Set DB = OpenDatabase("外部DB.MDB") DB.Execute ("ALTER TABLE 既存テーブル ADD 追加フィールド CHAR(255)") DB.Close 'データベースを閉じる Set DB = Nothing 上記のようなプログラムを走らせたのですが、 作成された追加フィールドにデータを入力すると、 入力した値の後に指定サイズ分の空白文字ができてしまいます。 つまり、10文字入力した場合 255-10=245文字が空白として登録されてしまいます。 Unicode圧縮プロパティのせいかな、と思い、 Dim TBL As DAO.TableDef Dim FLD As DAO.Field Dim prUC As DAO.Property Set TBL = DB.TableDefs("既存テーブル") Set FLD = TBL.Fields("追加フィールド") Set prUC = FLD.Properties("UnicodeCompression") prUC.Value = True と、フィールド追加後にプロパティを変更してみたりもしたのですが、 やはり、空白が出てしまいます。 作成したフィールドの空白文字がセットされないようにするにはどのようなことを行えばよいのでしょうか。 ご教授のほど、宜しくお願い致します。

  • access2000VBAで、外部ファイルに書き込むには

    access2000 VBAで 「sample.htmlを作成、 tableテーブルのデータを書き込む」 をして、htmlファイルを自動作成したいのですが、 うまくVBAがかけません。 とりあえず、外部ファイルにデータを出力に取り組んでいます 外部ファイルの作成の仕方と、書き込みのところで、 どうしたらいいのか分からず、困っています。 アドバイスおねがいします。<(_ _)> Dim cnc As New ADODB.Connection Dim rst As New ADODB.Recordset Set cnc = CurrentProject.Connection rst.Open "table", cnc, adOpenKeyset, adLockOptimistic, adCmdTableDirect Open sample.html For Output As #1 If rst.EOF Then MsgBox "There are not recordset" GoTo db_Close End If Do Until rst.EOF Debug.Print rst!種類, rst!名前, rst!url Write #1, rst!種類, rst!名前, rst!url rst.MoveNext Loop Close #1 db_Close: rst.Close Set rst = Nothing cnc.Close Set cnc = Nothing End Sub

専門家に質問してみよう