• 締切済み

Accessを使ったデータの一括インポートについて

VBA初心者です。 現在ExcelのデータをAccessにインポートする方法を探しています。 フォルダの構成としては 親フォルダに子フォルダがあり、そのなかにファイルがあります。 例としましては 親フォルダ 子フォルダ ファイル名 A aaaa 1111 B bbbb 2222 C cccc 3333 D dddd 4444 E eeee 5555 F ffff 6666 と言った感じです。 自分なりに調べて1つのフォルダの中にあるデータは全てインポートできそうです。(aaaaフォルダ内等) 現在、親ごとにテーブル分けして一括インポートできる方法を探しています。 現在のコードは Private Sub AAA_Click() Dim dname As String Dim fname As String Dim tblname As String dname = "c:\フォルダ名\" tblname = "テーブル名" fname = Dir(dname & "*.xls") Do While fname <> "" DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, tblname, dname & fname, True fname = Dir() Loop End Sub これを用いようと考えてます。 ここから子フォルダ内を全て1つのテーブルにまとめるというところでつまづいております。 初心者のためコードも頂けると助かります。 よろしくお願いします。

みんなの回答

  • chayamati
  • ベストアンサー率41% (254/607)
回答No.2

こんにちは。その後いかがですか ★補足願います 　質問が抽象化されているので具体的にして下さい 　1.【AAA】はフォーム上に配置されたボックス名ですね 　　ボックス名はプロパティのその他タブの最初のプロパティです 　　フォーム上に表示されているのは【標題】です 　2."c:\フォルダ名\"にあるエクセルファイルのsheet名と列名は ★自分はAccessでインポートするのは次の手順でやります。 　手順の途中で画面が変わりますが【】内はマウス操作で進みます 　【外部データリボン】→【新しいﾃﾞｰﾀベース】→【ファイルから】 　→【Excel】→【参照】→【C;フォルダ名】→【OK】 　これでSheat名がテーブル名としてインポートされます。 　貴方のコードに【tblname】と単一になっていますので、 　ここへ集積されます。

画像を拡大する
  • chayamati
  • ベストアンサー率41% (254/607)
回答No.1

＞ここから子フォルダ内を全て1つのテーブルに 　まとめるというところでつまづいております。 ★命令文のAAAはフォームに配置したボックスですね 　失礼ながらエクセルファイルの仕組みが理解出来ませんので 　こちらで試す事が出来ませんが インポート命令がパスすれば,全てのレコードが一つの【tblname】 　にあるはずです 　[DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, tblname, dname & fname, True] ★インポートループに入る前にテーブルを初期化します ' DoCmd.RunSQL "delete from tblname:"。 　この命令で繰り返し試行できます 命令文は以下の通り ---------------------------------------------------------- Option Compare Database Option Explicit Private Sub AAA_Click() Dim dname As String Dim fname As String Dim tblname As String dname = "c:\フォルダ名\" tblname = "テーブル名" ' DoCmd.RunSQL "delete from tblname:" fname = Dir(dname & "*.xls") ' Do While fname <> "" DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, tblname, dname & fname, True fname = Dir() ' Loop End Sub

  1. カテゴリ
  2. パソコン・スマートフォン
  3. ソフトウェア
  4. Access（アクセス）

関連するQ&A

  • Excel複数シートをaccessへ一括インポート

    Excel複数シートを、accessへ1つのテーブルへ一括インポート (1) ワークブックは複数あります。 (2) ブックには、色々な名前のシート名があります。 (3) テーブルに指定する名前をワークブックに合わせればと思ってます 複数シートの一括取り込みの vb は以下の通り作ってみました。 ここでは、 vbの中で「テーブル名」・「ドライブ内のワークブック(xlsデータ）」指定しなければいけないので、 任意で「テーブル名」・「ワークブック(xlsデータ）」「ドライブ」を（ダイアログボックスなど）指定出来ればと思っています。 ===================================================================== Private Sub コマンド0_Click() '////////////////////////////////////////////////////////// '/Excel複数シートのAccessテーブルへのインポート / '/参照設定 Microsoft Excel x.x Object Library / '////////////////////////////////////////////////////////// Const csWsRng As String = "A1:D1000" Const csTblName As String = "インポートテーブル" Const csWbPath As String = "D:\" Dim voXlApp As Excel.Application Dim voXlWb As Excel.Workbook Dim voXlWs As Excel.Worksheet Set voXlApp = New Excel.Application voXlApp.Visible = True Set voXlWb = voXlApp.Workbooks.Open(FileName:=csWbPath & "\aaaa.xlsx", _ ReadOnly:=True) For Each voXlWs In voXlWb.Worksheets DoCmd.TransferSpreadsheet TransferType:=acImport, _ SpreadsheetType:=acSpreadsheetTypeExcel9, _ TableName:=csTblName, _ FileName:=voXlWb.FullName, _ HasFieldNames:=True, _ Range:=voXlWs.Name & "!" & csWsRng Next voXlWs voXlWb.Close voXlApp.Quit Set voXlWs = Nothing Set voXlWb = Nothing Set voXlApp = Nothing End Sub ===================================================================== ご教示頂ければと思います。 宜しくお願い致します。

  • Accessへのエクセルデータインポート

    Accessへのエクセルデータインポート 環境：Access2000/WinXP アクセス2000の特定テーブルへ、エクセルデータをインポートするよう組んだのですが、新しくデータを追加すると、これより前に入っていたデータがレコードを残して消えてしまいました。 新規データを追加した際にただの追加としたいのですがどこがおかしいのでしょうか。 Private Sub データ登録_Click() Dim objExcel As Object Dim varFilePath As Variant Dim bln As Boolean Dim varac As Variant Dim varxls As Variant Dim strrange As String Dim strmsg As String varac = "受講者情報一覧" Set objExcel = CreateObject("Excel.Application") varFilePath = objExcel.GetOpenFilename("Microsfot Exel (*.xls), *.xls", , "xls選択") If varFilePath <> False Then varxls = varFilePath Else Exit Sub End If Set objExcel = Nothing varxls = varFilePath strrange = "" strmsg = "Excelファイル" & varxls & " を、Accessテーブル " & varac & "へ、インポートします。" DoCmd.DeleteObject acTable, varac If MsgBox(strmsg, vbOKCancel) = vbOK Then DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, varac, varxls, True MsgBox "正常にインポート完了しました。" End If Exit Sub エラー: MsgBox "予期せぬエラーが発生しました。" & Chr(13) & "エラー番号：" & Err.Number & Chr(13) & _ "エラー内容：" & Err.Description, vbCritical Exit Sub End Sub

  • 定数の宣言ってdimは使えないのですか？

    ＶＢＡです。 標準モジュールに Option Explicit Public Const フォルダ名 As String = "新しいフォルダー" Sub aaaa() End Sub はできるのですが、 Option Explicit dim Const フォルダ名 As String = "新しいフォルダー" Sub aaaa() End Sub は、エラーになってしまいます。 Option Explicit Sub aaaa() dim Const フォルダ名 As String = "新しいフォルダー" End Sub もダメみたいです。 定数を使うときは、必ずPublicで宣言しなけらばいけないのでしょうか？

  • Access テキスト　インポート

    現在指定したファイルしかインポートしが出来ないのでこれを 指定したファイルをインポートしたいのですがどのようすれは、いいでしょうか？よろしくお願いします。 Private Sub コマンド5_Click() On Error Resume Next Dim MsgNo As Integer Dim Msg1, Msg2, Msg3 As String Dim su As String Dim cut As Integer Dim fd As String Dim suu As String Dim db As Database Dim d1 As Recordset Msg1 = " インポートを開始します。" Msg2 = "「DAT」ファイルがありません。" Msg3 = "「DAT」ファイルを c:\DATデータにコピーし、再度実行して下さい。" MsgNo = MsgBox(Chr(9) & Msg1 & Chr(9), 1) If MsgNo = 2 Then 'キャンセルボタンで終了 GoTo Exit_インポート_Click End If EmptyAllTable 'テーブルクリア Set db = CurrentDb Set d1 = db.OpenRecordset("t_製品データ") fd = Dir("C:\DATデータ\*.dat") If fd = "" Then 'ファイルがなければ、メッセージを表示、処理を戻します。 Beep MsgNo = MsgBox(Msg2 & Chr(13) & Chr(10) & Chr(13) & Chr(10) & Msg3, 16) GoTo Exit_インポート_Click End If

  • ACCESS2013で複数ファイルのインポート

    お世話になっております。 環境は windows7 ACCESS2013 ACCESS2013を使って特定フォルダにある、AAA1.csv AAA2.csv・・・・とファイル名下一桁が連番になっているデータをACCESS2013のT_AAAという名前のテーブルにインポートをさせたいです。 テーブルのフィールド名やデータ型はどのファイルも同一です。 色々とネットで検索したのですが、あまりに初心者レベルのために理解できずにおります。 アドバイスをお願いいたします。 ネットで調べて真似して書いてみましたがエラーになります。 DoCmdでエラーになります。 どこが悪いのかさっぱり解りません。 Private Sub コマンド0_Click() Dim MyPath As String Dim MyCSV As String MyPath = "C:\Users\OOO_OOO\Desktop\test\AAA*.csv" MyName = Dir(MyPath, vbNormal) Do While MyName <> "" DoCmd.TransferText acImportDelim, "T_AAA", _ "C:\Users\OOO_OOO\Desktop\test\" & MyName, False MyName = Dir Loop End Sub 大変申し訳ございませんが、アドバイスをお願い申し上げます。

  • VBAにて複数フォルダのエクセルファイルからデータ抽出を行いたいのですが…

    現在、下記の方法で複数のブックからデータを抽出し、 一覧表示をしています。（一覧表示をしているブックを仮にＡとします。） 今のままだと、同一フォルダ内のブックしか抽出されません。 これを、サブフォルダまで対象にするには、どうすれば良いのでしょうか？ 簡単に例をあげると、 フォルダ（1）の中にＡを入れておいて フォルダ（1）の下にあるサブフォルダ（1）、サブフォルダ（2）の中にあるブックからデータの抽出を行いたいのです。 現在つかっているVBAは Sub 抽出用() Dim FName As String Dim Folder As String Dim wb As Workbook Dim i As Integer, j As Integer Application.ScreenUpdating = False Folder = ThisWorkbook.Path & "\" i = 1: j = 1 Worksheets(1).Cells.ClearContents FName = Dir(Folder & "*.xls") Do While FName <> "" If FName <> ThisWorkbook.Name Then Workbooks.Open (Folder & FName) Workbooks(Workbooks.Count).Worksheets(5).Rows("1:1").Copy _ ThisWorkbook.Worksheets(5).Cells(i + 3, 1) Workbooks(Workbooks.Count).Close Application.StatusBar = j & "ファイル処理済み" i = i + 1: j = j + 1 End If FName = Dir() Loop Application.StatusBar = "" Application.ScreenUpdating = True MsgBox ("完了しました") End Sub です。 いいお知恵があれば、よろしくお願い致します。

  • ACCESSで EXCELのデータをインポートするには

    よろしくお願いします。ACCESS2000,EXCEL2000を使っています。 運営報告.XLS の一部のデータをテーブル（TBL入金）にインポートしたいのです。 １．マクロを組みました。添付をご覧下さい。 ワークシート名はどのように定義しますか？ 目的のワークシートが左端にあるときは予定通りですが ２．実はACCESSのAPが入っているフォルダーで関連のファイルを処理したいので次のようにコーディングしました Private Sub 入金インポート_Click() Dim ファイル名 As String ファイル名 = Replace(CurrentProject.FullName, CurrentProject.Name, "") & "運営報告.xls" DoCmd.TransferSpreadsheet acImport, 3, TBL入金, ファイル名, yes, "Q1:S2" End Sub ここでもワークシート名は要求しません 実行時エラー'2495' このアクションまたはメソッドを実行するには、[Table Name/テーブル名]引数が必要です。 のメッセージが出ます。どのようにしたらよいでしょうか コーディング中 "Q!:S2"に続いて「,」を入力するとUseOAを要求しているようですがこれはどのようなものですか

  • Excelマクロでフォルダ内のCSVファイルを一括で読み込ませるには？

    Excelファイルと同階層にあるCSVファイルを読み込ませるマクロを作ってみたのですが、正常に動作しません。 アドバイスいただければ幸いです。 Excel2003を使用しています。 Sub 同階層フォルダ内のCSV読込_Click() Dim fname As String 'ファイル名 Dim pathname As String 'パス名 Dim dat(1 To 4) As Variant '読み込んだデータ Dim rr As Long '対象行番号 Dim i As Integer '列のオフセット Dim j As Integer 'ファイル識別番号のオフセット '同階層フォルダ内のCSVファイルを参照 pathname = ".\*.csv" fname = Dir(pathname, vbNormal) 'データを挿入する行番号 rr = 2 '該当するファイルがある間 Do While fname <> "" j = 0 j = j + 1 'ファイルを開く Open fname For Input As #j 'ファイルの終端まで Do Until EOF(j) 'データを取得 Input #j, dat(1), dat(2), dat(3), dat(4) '読み込んだデータをセルに出力 For i = 1 To 4 Cells(rr, i).Value = dat(i) Next '行番号を更新 rr = rr + 1 Loop Close #j 'フォルダ内の次のファイルを検索 fname = Dir() Loop End Sub

  • ActiveWorkBook　VBA

    Sub test() Dim myCSV As String Dim Fname As Variant Dim Aname As String Dim Fullp As String Application.ScreenUpdating = False Fullp = ActiveWorkbook.FullName Pos = InStrRev(Fullp, "\") Fname = Left(Fullp, Pos) myCSV = Dir(Fname & "*.csv") Do Until myCSV = "" Workbooks.Open Fname & myCSV Aname = Left(Fullp, InStr(1, Fullp, ".") - 1) ActiveWorkbook.SaveAs filename:=Aname & ".xls", FileFormat:=xlExcel9795 ActiveWorkbook.Close myCSV = Dir() Loop Kill Fname & "*.csv" End Sub あるフォルダにあるcsvファイルをxlsで保存したいと思いましたが、アクティブになるBOOKがバラバラ？ で、うまくいきません。csvファイルを開いたときに そのファイルがアクティブになり、うまくloopできないでしょうか？

  • Excel2003 VBA Shell関数について

    AフォルダにあるZipファイルを検索し、そのファイルを解凍ソフトで開きBフォルダに解凍するマクロを作成中です。解凍ソフト自体に保存先フォルダを設定していますので、Bフォルダは関係ありません。 ---------------------------- Sub AAA Dim ksDir As String Dim ktExe As String Dim　fName　As String Dim i As Long 　Const KTS As String = ".zip" 　ksDir = "\\xxx.xxx.xxx.xxx\A\" 　fName = Dir (ksDir & "*" KTS , vbNormal) 　 Do While fName = <> "" 　 Shell "\\xxx.xxx.xxx.xxx\C\解凍ソフト.exe ktDir & fName" 　　　i = i + 1 　　　nName = Dir Loop End Sub -------------------------- 「Shell "\\xxx.xxx.xxx.xxx\C\解凍ソフト.exe ktDir & fName"」の”ktDir & fName”の部分に実在する ファイルのパスを入れるとうまくいきますが、変数を入れて処理するとうまくいきません。 どこか間違いがある、又は他によい記述のしかたがあれば教えてください。 よろしくお願いします。

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する