VBAでサブフォルダからのインポート方法
- AccessとExcelを使用して、特定のフォルダ内のサブフォルダからファイルをインポートする方法についての質問です。
- トップパスの設定方法やインポートファイルの名称の指定方法、インポート範囲の設定方法について、初心者の方に分かりやすく教えて欲しいとのことです。
- 現在、同じパス内にあるエクセルファイルを指定した範囲でテーブルにインポートすることはできているが、それをサブフォルダ内のファイルにも適用したいとしています。
- ベストアンサー
アクセス VBA サブフォルダからインポート
アクセス・エクセル2010を使用しています。 以下の作業を実行したいと考えていますが、初心者につき、ご教示ください! 1.ダイアログを表示させ、フォルダを指定したい:トップパス設定 2.1で指定したトップパス内(サブフォルダを含む)にある 一定のネーミングファイルを範囲を指定してインポート(マージ)したい 動作条件) a.トップパス:D:\test ←ダイアログで指定したい(可能であれば・・次回の動作時に覚えさせておきたい) b.インポートファイルの名称:*_3年目.xls(語尾に「_3年目」と付くエクセル) ←フォームのテキストボックスで設定したい c.インポート範囲:B7:Z56 ←変動するので、フォームのテキストボックスで設定したい 現在、同じパス内にあるエクセルファイルを指定した範囲でテーブルにインポートする というところまでは、ご親切な方にご教示いただき、以下にてうまく動いています。 初心者のため、どこをどう変更・設定すると 上記のような動きにできるのかがわかっておりませんため、 ご教示いただけないでしょうか。 ※[frm]![txt_範囲]:範囲指定をするフォームのテキストボックス 仮テーブル:取り込み時に作成するマージ用テーブル Dim f As Object Dim b As Object Dim c As Object Dim d As Object Dim t As Variant Dim e As Object Dim p As String Dim i As Long Dim sSql As String Dim x As String Set e = CreateObject("Excel.Application") t = e.GetOpenFilename("Excel Files (*.xls*), *.xls*") If t = False Then Exit Sub x = Forms![frm]![txt_範囲] Set f = CreateObject("Scripting.FileSystemObject") p = f.GetParentFolderName(t) Set d = f.GetFolder(p) Set b = d.Files On Error Resume Next sSql = "DROP TABLE 仮テーブル " CurrentProject.Connection.Execute CommandText:=sSql sSql = "DROP TABLE 一時テーブル " CurrentProject.Connection.Execute CommandText:=sSql On Error GoTo 0 For Each c In b If LCase(f.GetExtensionName(c)) Like "xls*" Then If i = 0 Then DoCmd.TransferSpreadsheet acImport, , "仮テーブル", c, True, x sSql = "ALTER TABLE 仮テーブル ADD COLUMN ファイル名 VarChar(50);" CurrentProject.Connection.Execute CommandText:=sSql sSql = "UPDATE 仮テーブル SET ファイル名='" & f.GetFileName(c) & "';" CurrentProject.Connection.Execute CommandText:=sSql i = i + 1 Else On Error Resume Next sSql = "DROP TABLE 一時テーブル " CurrentProject.Connection.Execute CommandText:=sSql On Error GoTo 0 DoCmd.TransferSpreadsheet acImport, , "一時テーブル", c, True, x sSql = "ALTER TABLE 一時テーブル ADD COLUMN ファイル名 VarChar(50);" CurrentProject.Connection.Execute CommandText:=sSql sSql = "UPDATE 一時テーブル SET ファイル名='" & f.GetFileName(c) & "';" CurrentProject.Connection.Execute CommandText:=sSql sSql = "INSERT INTO 仮テーブル SELECT * FROM 一時テーブル" CurrentProject.Connection.Execute CommandText:=sSql i = i + 1 End If End If Next On Error Resume Next sSql = "DROP TABLE 一時テーブル " CurrentProject.Connection.Execute CommandText:=sSql On Error GoTo 0 e.Quit Set e = Nothing MsgBox "データがインポートされました。" End Sub 尚、せっかく教えていただいたコードではありますが、 上記コードを用いては思った動作にならないのであれば、 新しい手法で教えていただくんでも構いません。 是非、よろしくお願いします!!
- Visual Basic
- 回答数3
- ありがとう数4
- みんなの回答 (3)
- 専門家の回答
質問者が選んだベストアンサー
こんにちは 参照設定「Microsoft Scripting Runtime」で、 モジュールの先頭から、 Option Compare Database Option Explicit Dim j As Long Dim x As String Dim sSql As String Sub Shori_0() Dim f As Object Dim b As Object Dim c As Object Dim d As Object Dim t As Variant Dim e As Object Dim p As String Dim i As Long Set e = CreateObject("Excel.Application") With e.FileDialog(4) If .Show = True Then t = .SelectedItems(1) Else e.Quit Set e = Nothing Exit Sub End If End With e.Quit Set e = Nothing x = Forms![frm]![txt_範囲] Set f = CreateObject("Scripting.FileSystemObject") On Error Resume Next sSql = "DROP TABLE テストテーブル " CurrentProject.Connection.Execute CommandText:=sSql sSql = "DROP TABLE 一時テーブル " CurrentProject.Connection.Execute CommandText:=sSql On Error GoTo 0 Call Shori_1(f.GetFolder(t), i) On Error Resume Next sSql = "DROP TABLE 一時テーブル " CurrentProject.Connection.Execute CommandText:=sSql On Error GoTo 0 End Sub Sub Shori_1(ByVal objFolder As Folder, ByRef j As Long) Dim u As Folder Dim w As File For Each u In objFolder.SubFolders Call Shori_1(u, j) Next For Each w In objFolder.Files With w Call Shori_2(.Path) End With Next Set u = Nothing Set w = Nothing End Sub Sub Shori_2(c As String) If c Like "*_3年目.xls*" Then If j = 0 Then DoCmd.TransferSpreadsheet acImport, , "テストテーブル", c, True, x sSql = "ALTER TABLE テストテーブル ADD COLUMN ファイル名 VarChar(250);" CurrentProject.Connection.Execute CommandText:=sSql sSql = "UPDATE テストテーブル SET ファイル名='" & c & "';" CurrentProject.Connection.Execute CommandText:=sSql j = j + 1 Else On Error Resume Next sSql = "DROP TABLE 一時テーブル " CurrentProject.Connection.Execute CommandText:=sSql On Error GoTo 0 DoCmd.TransferSpreadsheet acImport, , "一時テーブル", c, True, x sSql = "ALTER TABLE 一時テーブル ADD COLUMN ファイル名 VarChar(250);" CurrentProject.Connection.Execute CommandText:=sSql sSql = "UPDATE 一時テーブル SET ファイル名='" & c & "';" CurrentProject.Connection.Execute CommandText:=sSql sSql = "INSERT INTO テストテーブル SELECT * FROM 一時テーブル" CurrentProject.Connection.Execute CommandText:=sSql j = j + 1 End If End If End Sub
その他の回答 (2)
- ushi2015
- ベストアンサー率51% (241/468)
こんにちは こちらでテストしている限りでは動いています。 どのコードでエラーになっていますか?
補足
ご連絡遅くなりました。 ご質問しておりましたコンパイルエラーですが、(別件で)PCを再起動したところ、エラーが出なくなりました。 どういうことなのかは不明ですが、大丈夫そうです。 お騒がせして申し訳ありませんでした。
- ushi2015
- ベストアンサー率51% (241/468)
こんにちは モジュールの先頭から、と書いておきました。 新しいモジュールを挿入して、その先頭から貼り付けて下さい。 既に、 Option Compare Database Option Explicit が有る場合も、面倒なので上書きして下さい。
補足
なるほど、失礼しました。 さて、今度は「実行時エラー:抽出条件でデータ型が一致しません。」と出てしまします。 抽出条件も何も・・・???です。 すみません。
関連するQ&A
- VBでAccess DBにinset処理をかける
Dim cn As ADODB.Connection '接続 (1)Set cn = CurrentProject.Connection '実行 cn.Execute strSqlm←SQLがはいっています。 '終了 cn.Close: Set cn = Nothing (1)でオブジェクトが必要です。というエラーがでます。 解決策をお願いします。
- 締切済み
- Visual Basic
- AccessVBAでInputBoxの値をSQLに組み込むには
AccessVBA超初心者です。 テーブル上の項目の受付日時をInputBoxよりGetして、 フラグが1であるものに一律その値をセットしたいと思っているのですが、なかなか上手くいきません。 おそらくSQLの中に直接パラメタを入れられないのだと思いますが、どうしていいかわかりません。 すみませんが、よろしくお願いいたします。 ----------------------------------------------- Public Sub cmd_1_Click() Dim cmdReset As New ADODB.Command Dim cmdResult As New ADODB.Command Dim strDate As String cmdReset.ActiveConnection = CurrentProject.Connection cmdResult.ActiveConnection = CurrentProject.Connection cmdReset.CommandText = "UPDATE テーブル SET 受付日時='';" cmdReset.Execute strDate = InputBox(prompt:="処理日付を入力して下さい。(yyyy/mm/dd)", Title:="処理日の入力") cmdResult.CommandText = "UPDATE テーブル SET 受付日時 = strDate WHERE フラグ='1' " cmdResult.Execute MsgBox "終了" End Sub ------------------------------------------
- ベストアンサー
- オフィス系ソフト
- ACCESSでレコード数の取得の仕方
Aテーブルのレコード数を取得しようと思い、次のPGを考えました。(Aテーブルには10件のデータが入っています。)ですが、「-1」という数値が返ってきます。なぜでしょうか? Dim objADOCON As ADODB.Connection Dim objADORS As ADODB.Recordset Dim strSQL As String Set objADOCON = Application.CurrentProject.Connection strSQL = "SELECT * FROM Aテーブル" Set objADORS = objADOCON.Execute(strSQL) MsgBox objADORS.RecordCount , vbOKOnly, "レコード数"
- ベストアンサー
- その他(データベース)
- VBAのExecuteの違いについて教えてください。
22歳男性です。現在、VBAを勉強してます。 今日は、そのVBAについて質問があります。 以下に2つのExecuteのソースがあるんですが、2つの違いがよくわかりません。 ------------------------------------------------------ dim a as new ADODB.Connection dim b as new ADODB.Command dim c as new ADODB.Recordset (中略) 1: set c = a.execute 2: set c = b.execute ------------------------------------------------------ 簡単に言うと、「Connection」「Command」で使われるExecuteの違いです。 知っている方がいましたら、ご回答のほどよろしくお願いします。
- 締切済み
- その他(プログラミング・開発)
- Accessのテーブルの文字列フィールドにVBAでアクセスするには?
いつもお世話になっております。困っていることがありますので教えていただければ幸いです。 AccessのテーブルAに、メモ型のフィールドBがあり、1000文字くらいの文字が入っています。VBAの関数Cの中でそのテーブルにアクセスし、1000文字をいろいろ処理したいと思っています。見よう見まねで試しに Dim cn As ADODB.Connection Dim rs As ADODB.Recordset Dim FileNum As Integer Set cn = CurrentProject.Connection Set rs = New ADODB.Recordset rs.Open テーブルA, cn, adOpenDynamic, adLockOptimistic msgbox !フィールドB としてみたのですが、なぜか255文字までしか表示されません。VBAを用いてテーブル(やクエリ)にアクセスし、256文字以上の文字列を扱う方法はありませんでしょうか? 何かこちらで勘違いしているところがありましたら、ご指摘いただければと思います。よろしくお願いします。
- 締切済み
- オフィス系ソフト
- Access VBAでのデータ抽出の仕方
Access VBAでのデータ抽出の仕方 Access VBAでデータを抽出して、テキストボックスにデータを配置したいと思います。 Formにtxt1~txt10までのテキストボックスが10個あります。 テーブルからデータを引っ張ってきてレコードセットにいれます。 Dim objADOCON As ADODB.Connection Dim objADORS As ADODB.Recordset Dim strSQL As String Dim SQL As string SQL = "Select * from Table1" Set objADOCON = Application.CurrentProject.Connection Set objADORS = objADOCON.Execute(SQL) これでレコードセットを取得しました。このレコードセットは「ID」列があり、プライマリーキーを設定しています。またZAIKOという列もあります。 ID=001の時、在庫は100 ID=002の時、在庫は200 といったように条件を絞って、テキストボックスに値を入れたいと思います。 objADORS.Filter = "[ID] = '001'" txt1.value = objADORS!ZAIKO objADORS.Filter = "[ID] = '002'" txt2.value = objADORS!ZAIKO ..... を10回繰り返せば条件毎に値がセットするのはわかります。 ただし、あまりスマートなやり方ではなく、もっといい方法があるんじゃないかと思うのですが考えつきません。 何か良い方法、手段がありましたらお教え下さい。 よろしくお願いします。
- ベストアンサー
- その他(データベース)
- アクセスVBA。ADO
CSVから列を分割してテーブルにしたいかったので 下記のコードを記述しましたが、 Dim cn As ADODB.Connection Dim rs As New ADODB.Recordset Dim datacount As Long Set cn = New ADODB.Connection With cn .ConnectionString = "Provider=Microsoft.jet.OLEDB.4.0;Data Source=" & CurrentProject.Path & "\;" .Properties("Extended Properties").Value = "text;HDR=YES;" .Open End With Set rs = cn.Execute("SELECT * FROM 構成マスタ.csv") datacount = rs.Fields.Count For i = 0 To datacount strsql = "SELECT " & rs.Fields(i).Name & " INTO " & rs.Fields(i).Name & " FROM 構成マスタ.csv;" cn.Execute strsql Next i rs.Close cn.Close Set rs = Nothing Set cn = Nothing SQLを実行するところで、「日付エラー」となってしまいます。 データには特に日付等はないのでエラーになる原因がわかりません。 どなたかご教示いただけますでしょうか。
- 締切済み
- Visual Basic
- アクセスVBAです
Sub test() Dim DB As Database Dim T As TableDef Dim myTable As String myTable = "Table1" Set DB = OpenDatabase(CurrentProject.FullName) For Each T In DB.TableDefs If T.Name = myTable Then DoCmd.DeleteObject acTable, myTable Exit For End If Next DB.Close Set DB = Nothing End Sub これを実行しようとすると Dim DB As Database の部分で コンパイルエラー プロジェクトではなく、ユーザ定義型を指定してください。 と言うエラーになります。 Dim DB As Objectにすればエラーにならずに進みますが 何が原因なのでしょうか?
- ベストアンサー
- その他(データベース)
- Access インポート時にファイル名を追加したい
Access2007のVBAで、あるフォルダ内の全CSVをインポートしたくて、次のページを参考にして、標準モジュールを組みました。 そして、あるフォルダ内全CSVのインポートには成功しました。 その時、全CSVはテーブル「Import_Table」にインポートされます。そこで、インポート時に元のCSVのファイル名をインポート先のテーブルの最後のフィールドに追加することはできるでしょうか? もし、知っておられる方がいたら、教えてください。 お願いします。 http://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q1226480442 _/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/ /_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/ Sub ImpCSV() Dim objFs As Object Dim objFld As Object Dim objFl As Object Const cnsFILEPATH = "C:\Documents and Settings\hoge\デスクトップ\hogehoge" 'フォルダー名 Const cnsTABENAME = "Import_Table" Set objFs = CreateObject("Scripting.FileSystemObject") Set objFld = objFs.GetFolder(cnsFILEPATH) For Each objFl In objFld.files If Right(objFl.Name, 4) = ".csv" Then DoCmd.TransferText TransferType:=acImportDelim,"インポート定義",tablename:=cnsTABENAME, _ filename:=cnsFILEPATH & "\" & objFl.Name, hasfieldnames:=False End If Next Set objFl = Nothing Set objFld = Nothing Set objFs = Nothing End Sub /_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/ _/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
- 締切済み
- Access(アクセス)
- ACCESSのエラーで困っています
ACCESSのVBAで以下のコードを実行するとエラーがでて困っています。 エラーは「行セットは逆方向フェッチをサポートしていません」とでます。 どこに問題があるのかをヘルプで調べても全く分かりませんでしたので、 問題点、アドバイスがあれば教えてください。 環境はACCESS2000、WIN98です。 宜しくお願いしますm(_ _)m Dim recR As New ADODB.Recordset Dim cmdR As New ADODB.Command cmdR.ActiveConnection = CurrentProject.Connection cmdR.CommandText = "~" Set recR = cmdR.Execute Do Until recR.EOF If ~ Then recR.MoveLast ←ここでエラーがでます End If recResult.MoveNext Loop
- ベストアンサー
- オフィス系ソフト
お礼
今回も本当に助かりました! また何かありましたら、ご教示のほど よろしくお願い致します。
補足
参照設定しましたが、 Option Compare Database 部分で 「プロジーシャ内では無効です。」のコンパイルエラーが出てしまいます。 今回もご面倒おかけしますが、教えていただけますでしょうか。 よろしくお願いします!