ダイアログボックスからフォルダ名を取得し、フォルダ内のCSVファイルをすべてアクセスのテーブルにインポートしたいが、１つめのCSVファイルの中身が繰り返しインポートされてしまう
- ダイアログボックスを表示し、ユーザーにフォルダ名を入力してもらう。
- 選択されたフォルダ内にあるCSVファイルを一つずつ取り出し、アクセスのテーブルにインポートする。
- インポート処理の際、１つめのCSVファイルの中身が繰り返しインポートされてしまう問題が発生している。
- ベストアンサー
ダイアログボックスからフォルダ名を取得し、フォルダ内のCSVファイルを
ダイアログボックスからフォルダ名を取得し、フォルダ内のCSVファイルをすべてアクセスのテーブルにインポート使用と思っています。 ところがCSVファイルの数の分だけ、１つめのCSVファイルの中身が繰り返しインポートされてしまっています。 どの部分に誤りがあるのでしょうか？ お知恵を拝借できますでしょうか・・・。 コードは以下になります。 Private Sub cmd06_Click() Dim MyFile As String Dim MyName As String Dim MyName02 As String Dim strFolderName As String strFolderName = GetFolderName() 'フォルダ選択ダイアログを表示 If Len(strFolderName) > 0 Then '選択結果を評価 MyFile = strFolderName & "\*.csv" '【拡張子csvのファイルのみ取得】 MyName = Dir(MyFile, vbNormal) MyName02 = "\" & MyName Do While MyName <> "" If MyName <> "." And MyName <> ".." Then If GetAttr(strFolderName & "\" & MyName) <> vbDirectory Then DoCmd.TransferText acImportFixed, "T03_インポート定義", "T03_全CSVデータ", strFolderName & MyName02, False, "" '【取得したファイルをインポート】 End If End If MyName = Dir Loop Else MsgBox "フォルダは選択されませんでした" End If MsgBox "データのインポートが終了しました" End Sub
- reika_000
- お礼率37% (6/16)
- その他MS Office製品
- 回答数1
- ありがとう数1
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
繰り返しの中でインポートされるファイル名が変わらなければなりません。 インポートの箇所で、ファイル名がどうなってるかに着目すると、最初にフォルダ選んだときからMYNAME02が変わってません。このあたりではないですか。わかりますか。 コード回答例を期待しないで、まずはそうなる経緯、ロジックを考えてみて下さい。
関連するQ&A
- ACCESS VBA でのCSV取込エラー
ACCESS VBA でのCSV取込エラー ACCESSにてフォルダ内にあるCSVファイルをすべてインポートしようとしています。 インポート定義を作成して、下記のコードを書いてみましたが、 データはすべてインポートされるのですが、 カンマが無視され、フィールドとフィールドの中間で途切れてデータが格納されてしまいます。 またフィールド４は日付形式なのですがこれがインポートエラーになります。 フィールド１ フィールド２ フィールド３ フィールド４ aaa aa,bbb bbb,ccc エラー ２日間ほどネットサーフィンをして調べたのですが、 回避方法が見つからなかったので、お知恵を拝借できますでしょうか？ よろしくお願いいたします。 Private Sub cmd06_Click() Dim MyFile As String Dim MyName As String Dim strFolderName As String DoCmd.SetWarnings False DoCmd.OpenQuery "Q09_全CSVデータ削除" DoCmd.SetWarnings True strFolderName = GetFolderName() 'フォルダ選択ダイアログを表示 If Len(strFolderName) > 0 Then '選択結果を評価 MyFile = strFolderName & "\*.csv" '【拡張子csvのファイルのみ取得】 MyName = Dir(MyFile, vbNormal) Do While MyName <> "" If MyName <> "." And MyName <> ".." Then If GetAttr(strFolderName & "\" & MyName) <> vbDirectory Then DoCmd.TransferText acImportFixed, "インポート定義", "T03_全CSVデータ", strFolderName & "\" & MyName, False, "" '【取得したファイルをインポート】 End If End If MyName = Dir Loop Else MsgBox "フォルダは選択されませんでした" End If MsgBox "データのインポートが終了しました" End Sub
- ベストアンサー
- その他MS Office製品
- Excel 2010 VBA:ファイル名を読み込む
下は複数のcsvファイルを一つに合体するVBAです。これにシートの右端に読み取ったファイル名を追加するにはどうしたらよいでしょうか。 よろしくお願いします。 Sub macro1() Dim myPath As String Dim myFile As String Dim s As String myPath = ThisWorkbook.Path & "\" On Error Resume Next Kill myPath & "合体版.csv" On Error GoTo 0 myFile = Dir(myPath & "*.csv") If myFile = "" Then Exit Sub Open myPath & "合体版.csv" For Output As #1 Do Until myFile = "" Open myPath & myFile For Input As #2 Do Until EOF(2) Line Input #2, s Print #1, s Loop Close #2 myFile = Dir() Loop Close #1 End Sub
- ベストアンサー
- Excel（エクセル）
- DIR関数を使ったファイル名の取得
おはようございます。 txtファイル名とdocファイル名を取得したく、以下のコードを作成してみました。 DIR関数を使って、ファイルリストボックスのPatternプロバディのように、複数の形式のファイル名を同時に取得する方法はあるのでしょうか? 是非、教えてください。よろしくお願いします。 ----------------------------- Private Sub Form_Load() Dim MyName MyName = Dir("C:\My Documents\*.txt") Do While MyName <> "" MsgBox MyName MyName = Dir Loop MyName = Dir("C:\My Documents\*.doc") Do While MyName <> "" MsgBox MyName MyName = Dir Loop End End Sub -------------------------------------
- ベストアンサー
- Visual Basic
- EXCEL→CSV形式で別ファイルに保存
EXCELデータ内のある１つのシートのデータをそのまま別ファイル(CSV)に保存したいのですがうまくいかないので教えてください。 本を見ながらこのようなマクロを作ったところ、EXCEL(○○.xls)の指定したシート(keihi)のみをCSV形式で別フォルダ(C:\経費振替)に保存することができたんですが、 元のEXCELも、ファイル名称・形式がCSV(○○.xls→keihi.csv)に変わってしまいます。 エクセルのファイル名、形式は変えずにできる方法ってありますか?? Sub データはきだし() Dim Ret As String Dim Res As Integer Dim FolderName As String Set WK1 = Worksheets("1 依頼書") Set WK4 = Worksheets("keihi") FolderName = "C:\経費振替" Ret = Dir(FolderName, 16) If Ret = "" Then Res = MsgBox("DATA保管用フォルダを作成します。", vbYesNo) If Res = vbYes Then MkDir FolderName End If End If ' Dim Res2 As Integer Res2 = MsgBox("DATAを作成します。", vbYesNo) WK4.Select If Res2 = vbYes Then With WK4 .SaveAs Filename:=FolderName & "\keihi", FileFormat:=xlCSV ←多分ココが何か間違ってるのだと思うんですが。 End With
- ベストアンサー
- Visual Basic
- フォルダー名に特殊文字？が存在する場合にエラー発生
以下のコードでフォルダー名を取得しています。 しかし、フォルダー名に特殊文字？が存在する場合に下記でエラーが発生します。 例えば「Oxygène」 でeの上に’があるなど If (GetAttr(MyPath & MyName) And vbDirectory) = vbDirectory Then 実行エラー 53： ファイルが見つかりません。 これは、excelの仕様で処理できないのでしょうか ？ 他のコードで処理できれば教えて下さい。 --------------------------------------- Sub フォルダ名取得() Dim MyName Dim MyPath Dim i As Long ’仮の消込（初期化： 前回の記入文をクリアー） Range("A5:H50").Clear i = 1 ' フォルダーを自由に選べること。 参考：officeTANAKA With Application.FileDialog(msoFileDialogFolderPicker) If .Show = True Then ' MsgBox .SelectedItems(1) If Len(.SelectedItems(1)) = 3 Then ' c:\の場合とサブフォルダーの場合 MyPath = .SelectedItems(1) Else MyPath = .SelectedItems(1) & "\" End If End If End With If MyPath = Empty Then MsgBox "フォルダー名表示をキャンセルしました。": Exit Sub 'Range("b2:c2").ShrinkToFit = True ' 縮小してセル内に表示 MyName = Dir(MyPath, vbDirectory) ' 最初のフォルダ名を返します。 '親フォルダー Range("A2") = MyPath Do While MyName <> "" ' ループを開始します。 ' 現在のフォルダと親フォルダは無視します。 If MyName <> "." And MyName <> ".." Then ' ビット単位の比較を行い、MyName がフォルダかどうかを調べます。 If (GetAttr(MyPath & MyName) And vbDirectory) = vbDirectory Then Range("a" & i + 4) = MyPath & MyName ' アクティブシートA5セルから下方にフルパス表示。 Range("b" & i + 4) = MyName ' アクティブシートB5セルから下方にフォルダ名表示 i = i + 1 End If End If MyName = Dir ' 次のフォルダ名を返します。 Loop MsgBox MyPath & "の中にフォルダーは" & (i - 1) & "個のフォルダーがありました。" End Sub
- ベストアンサー
- Excel（エクセル）
- 複数のCSVファイルを一つのブックに
エクセルvbaの達人の皆様、どうか助けてください。 フォルダ内の複数のCSVファイルを一つのブックにシートを分けて取り込むvbaが知りたいです。問題は、 ・複数のcsvを一気に取り組みたい ・一つのブックに、csvファイル別にシートを分けたい ・文字化けを何とかしたい！！（文字コードをutf8にしたい） この3つをクリアすることですが、、 ネットで調べてみたところ、あるページに載っている以下のマクロを試してみたのですが、やはり文字化けしてしまいます。文字コードの設定をどこかで指定しなければならないと思いますが、どう改良すればよろしいでしょうか。（ちなみに、VBAは全くの初心者です） Sub test() Dim myObj As Object Dim myDir As String Dim myFileName As String Dim myc As Long Application.ScreenUpdating = False Set myObj = CreateObject("Shell.Application"). _ BrowseForFolder(0, "取り込むフォルダを選択してください", 0) If myObj Is Nothing Then Exit Sub myDir = myObj.Items.Item.Path If Right(myDir, 1) <> "\" Then myDir = myDir & "\" 'フォルダ内のExcelファイルを確認 myFileName = Dir(myDir & "*.csv") myc = 0 Do While myFileName <> "" Workbooks.Open (myDir & myFileName) myc = myc + 1 Workbooks(myFileName).Worksheets(1).Move ThisWorkbook.Worksheets(1) myFileName = Dir() Loop If myc = 0 Then MsgBox "CSVファイルがありません。" End If Application.ScreenUpdating = True End Sub （上記のマクロはhttp://www.excel.studio-kazu.jp/kw/20110705155353.html#commentから引用しました。）
- ベストアンサー
- Excel（エクセル）
- エクセル（ＶＢＡ）でファイル名（サブフォルダ含む）、更新日時を表示させたい
エクセルのＶＢＡであるフォルダ以下の全てのファイル名と更新時間をエクセルシート上に表示させたく、以下のプログラムを作成したのですが 、サブフォルダ内のファイルを表示させることができません。何か良い方法がありましたら教えていただけないでしょうか？宜しくお願いいたします。 Sub SAMPLE() Dim serchPass As String j = 1 Mypath = "C:\My Documents\" MyName = Dir(Mypath, vbDirectory) Do While MyName <> "" ' ループを開始します。 ' 現在のフォルダと親フォルダは無視します。 If MyName <> "." And MyName <> ".." Then ' ビット単位の比較を行い、MyName がフォルダかどうかを調べます。 If (GetAttr(Mypath & MyName) And vbDirectory) = vbDirectory Then Debug.Print MyName ' フォルダであれば、それを表示します。 Else: GoTo 10 End If serchPass = Mypath & MyName With Application.FileSearch .NewSearch .LookIn = serchPass If .Execute() > 0 Then For i = 1 To .FoundFiles.Count Cells(i + j, 1).Value = .FoundFiles(i) Cells(i + j, 3) = FileDateTime(.FoundFiles(i)) Next i j = i + j End If End With 10 End If MyName = Dir ' 次のフォルダ名を返します。 Loop End Sub
- ベストアンサー
- オフィス系ソフト
- 【AccessVBA】ダイアログで複数選択しCSVインポートする
お世話になります 現在1ファイルごとでインポートさせていますが 複数選択でインポートさせたいのですがわかる方ご教授お願いします。 ■現在のVBA '実行ボタンのイベント Private Sub 参照_Click() Dim strFileName As String 'ファイルを開くダイアログを表示 strFileName = GetFile("") If Len(strFileName) > 0 Then Me.テキスト1 = strFileName Else MsgBox "ファイルは選択されていません! End If End Sub Private Sub 実行_Click() TextConv Me.テキスト1, "定義名", "テーブル名" End Sub 'テキストコンバートルーチン Sub TextConv(strFle As String, strInp As String, strTbl As String) If MsgBox("インポートしますか？", 4, "実行確認") = vbYes Then DoCmd.TransferText acImportDelim, strInp, strTbl, strFle, False MsgBox "テーブルデータを更新しました" End If End Sub 上記の内容を変更だけでよいのか まったく書き直しかどうかもわかっていません わかる方ご教授よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- VBA フォルダ内のファイル名一覧
下のようなコードですが、Dir("C:\見積\*.xls")の部分を このコードを書いてあるブックのあるフォルダの名前をもっと簡単に取得してコードにできないでしょうか。 もうひとつ付け加えたいこともあります。ファイル名一覧にする際、このブックと「XXX.xls」という名前のブック名以外の一覧にしたいのですが、これもお手上げですので、あわせてお願いします。 Sub test() Dim myFile As String Dim fl As Integer myFile = Dir("C:\見積\*.xls") fl = 9 Do While myFile <> "" fl = fl + 1 Cells(fl, 3).Value = myFile myFile = Dir() Loop End sub
- ベストアンサー
- オフィス系ソフト
- 複数フォルダに格納されたファイル名取得VBA
お世話になっております。 あるフォルダに複数のフォルダが格納されており、更にそのフォルダの中にあるファイルの情報を取得するプログラムを書いたのですが、実行すると下記のようなエラーとなってしまいます。 ■エラー プロシージャの呼び出し、または引数が不正です 下から3行目、「buf = Dir()」が問題であることはわかるのですが、 何が問題でどのように解決したらいいかわかりません。 どなたかご教授の程よろしくお願い致します(>_<) ------------------------------------------------------------------------ Sub test() Dim buf As String Dim fName As String Dim msg As String buf = Dir("*.*", vbDirectory) Do While buf <> "" If GetAttr(buf) And vbDirectory Then If buf <> "." And buf <> ".." Then fName = Dir(CurDir & "\" & buf & "\" & "*.jpg") Do While fName <> "" cnt = cnt + 1 Cells(cnt, 1) = buf Cells(cnt, 2) = fName msg = msg & buf & "\" & fName & vbCrLf fName = Dir() Loop MsgBox msg End If End If buf = Dir() Loop End Sub ------------------------------------------------------------------------ これが実現できないと細かい作業を毎日繰り返す事となり、 かなり業務不可が高いです。。 繰り返しになってしまいますが、どなたかご回答よろしくお願い致します。
- ベストアンサー
- その他（プログラミング・開発）
お礼
ありがとうございました。 おっしゃるとおり、MyName02の値がループしていないことが原因でした。