• 締切済み

サブフォルダ内の全てのテキストファイルを１発処理する方法

Excel2007のVBAを使い、下記のようなマクロを作成しました。 （質問に必要そうな所だけ掲載しています。） Dim dir_name As String ' ディレクトリ名 Dim file_name As String ' ファイル名 Dim EffectiveRow As Integer ' 開始行数/Excel/Row(行) Dim ShellApp As Object ' SHDOCVW.DLL / MIC Dim oFolder As Object ' フォルダパス EffectiveRow = Range("A65536").End(xlUp).Row Set ShellApp = CreateObject("Shell.Application") Set oFolder = ShellApp.BrowseForFolder(0, "フォルダ選択", 1) dir_name = oFolder.items.Item.Path ChDir dir_name file_name = Dir("*.txt", vbNormal) Do Until file_name = "" EffectiveRow = EffectiveRow + 1 Call ImportText(file_name, EffectiveRow) file_name = Dir() Loop ShellApp.BrowseForFolderを使い、指定したフォルダを選択すると、 その中に有る、テキストファイル(.txt)を、全てExcelに書き込む というマクロを作成したのですが、もっと汎用性を高くするために、 下記の内容を実現したく思っています。 - ↓ 実現したい事↓ - - 状況 - *フォルダの中に、サブフォルダが複数有り、そのサブフォルダの中に、 テキストファイル(.txt)が複数入っている。 - 処理 - サブフォルダを格納している*フォルダを、ShellApp.BrowseForFolderで 選択し、一度でサブフォルダ内のテキストファイルを全てExcelに書き込 めるようにしたい。 上記のマクロから発展させて、このような処理を行う事は出来るでしょうか？ また、どのようにすれば実現させることが出来るでしょうか？ ご教授のほど、よろしくお願いします。m(_ _)m ※ [*フォルダ ] は同一フォルダです。

みんなの回答

  • myRange
  • ベストアンサー率71% (339/472)
回答No.4

途中から。。。 '---------------------------------------------- ●ChDir dir_name　　'●これ不要だと思うが。。 dir_name = oFolder.items.Item.Path Dim fso Dim fsoFolder Dim fsoSubFolder Set fso = CreateObject("Scripting.FileSystemObject") Set fsoFolder = fso.GetFolder(dir_name) For Each fsoSubFolder In fsoFolder.SubFolders 　file_name = Dir(fsoSubFolder & "\*.txt", vbNormal) 　Do Until file_name = "" 　　　EffectiveRow = EffectiveRow + 1 　　　Call ImportText(file_name, EffectiveRow) 　　　file_name = Dir() 　Loop Next fsoSubFolder '------------------------------------------ それから、Dir関数を使用せずに For Each fsoSubFolder In fsoFolder.SubFolders 　　For Each fsoFile In fsoSubFolder.Files 　　　　If Right(fsoFile, 4) = ".txt" Then とする方法もありますが後がこの場合のfsoFileはフルパスになります。 ■注■ サブフォルダーの中に更にサブフォルダーがある場合は上記ではできません。 その場合は再起処理をすることにになります。 以上です。 　

ysg4016
質問者

お礼

やりたかった処理を実装出来ました。 ありがとうございました！m(_ _)m

  • mitarashi
  • ベストアンサー率59% (574/965)
回答No.3

http://okwave.jp/qa4847039.html のNo.2に下位フォルダーも含むファイルリストを取得するコードを回答しています。全フォルダーを調べ終わってから、得られたファイルリストに対して書き出し処理するというのではいかがでしょうか。ファイルリストに加えるときにテキストファイルだけ選別するか、あるいは得られたファイルリストの中でテキストファイルだけを処理対象にする様な処置は必要ですが。

ysg4016
質問者

お礼

やりたかった処理を実装出来ました。 ありがとうございました！m(_ _)m

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

Dim FSO, FLD Set FS= CreateObject("Scripting.FileSystemObject") Set FLD = FSO.GetFolder(oFolder.items.Item.Path) 処理 FLD Sub 処理(FLD) '★再帰呼び出しによる処理 　　Dim SF 　　For Each SF In FLD.SubFolders '★フォルダ内のサブフォルダ 　　　　処理 SF '★各サブフォルダに対し同じことを繰り返す 　　Next 　　'★-- ここからフォルダ内のファイルの処理 　　ChDir FLD.Path 　　Dim file_name 　　file_name = Dir("*.txt") 　　=== ここからは以前の処理なので省略 === End Sub

ysg4016
質問者

お礼

ご返答ありがとうございます。 ここまでヒントを頂いても難しい…。 もう少し悩んでみます。 ありがとうございますm(_ _)m

  • fujillin
  • ベストアンサー率61% (1594/2576)
回答No.1

こんにちは ひとつのフォルダ内の処理はできているのですよね？ その中で、サブフォルダが見つかったら、そのサブフォルダを引数にして 自分自身を呼び出せるように、全体を少し修正すればできると思います。 （キーワード：再帰処理） ＜参考＞ http://itpro.nikkeibp.co.jp/article/COLUMN/20060206/228661/ http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_110_080.html

ysg4016
質問者

補足

ご回答有りがとうございます。 何となくは解るのですが、中々上手く いきません・・・。 １つめのサブフォルダを見終わったら、 次のサブフォルダに移動する？方法が 解らないというのが１つあります（汗

  1. カテゴリ
  2. [技術者向] コンピューター
  3. プログラミング・開発
  4. Visual Basic

関連するQ&A

  • あるフォルダ内のすべての.xlsファイルを開いて印刷

    お世話になります。 エクセルVBAの質問です。 あるフォルダを指定して、その中のファイルを順番に開いて印刷したいと思っていますが、どのように記述したらよいのでしょうか。 下記、いろいろなところから引っ張ってきたのをつないだコードです。 すみませんが、ご教授願います。 Dim ShellApp As Object Dim oFolder As Object Dim targetFolderName As String Dim Xlname As String, Dpath As String, Opn As Integer Dim Fnd As Boolean Set ShellApp = CreateObject("Shell.Application") Set oFolder = ShellApp.BrowseForFolder(0, "フォルダ選択", 1) If oFolder Is Nothing Then Exit Sub End If targetFolderName = oFolder.items.Item.Path Dpath = "targetFolderName" Xlname = Dir(Dpath & "*.xls") Do While Xlname <> "" Opn = 0 Do Fnd = False For Each file_name In Windows If file_name.Caption = Xlname Then Fnd = True Exit For End If Next If Not Fnd Then If Opn = 1 Then Exit Do Workbooks.Open Filename:=Dpath & Xlname Opn = 1 End If ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True Loop Xlname = Dir() Loop

  • VBAでのフォルダ指定方法について

    ＥＸＣＥＬファイルが保存されているディレクトリ配下のフォルダーを指定できるようにしたくていろいろ試してみたのですが、うまくいきません。 どなたか、お知恵をお貸しください。 以下ソースです。 Private Sub CommandButton1_Click() Dim ShellApp As Object Dim oFolder As Object Dim MyPath As String MyPath = ActiveWorkbook.Path Set ShellApp = CreateObject("Shell.Application") Set oFolder = ShellApp.BrowseForFolder(0, "処理ファイルの格納フォルダ選択", 1, MyPath) If Not oFolder Is Nothing Then TextBox1.Value = oFolder.Items.Item.Path End If Set ShellApp = Nothing Set oFolder = Nothing End Sub

  • VBAでのフォルダ指定方法について ２回目

    フォルダー指定時に使用する「ShellApp.BrowseForFolder」について教えてください。 パス指定するところに直にフルパスを記述すると、そのフォルダを先頭として配下のフォルダが表示されます。 －イメージー 【業務】 　【業務１】 　【業務２】 しかし、変数にするとエラーは出ないのですが指定したパスを無視してデフォルトの表示となります。 －イメージー 【デスクトップ】 　【マイドキュメント】 　【マイコンピュータ】 　　　　　： ファイルを置いて実行させるフォルダーが固定で無いので、ファイルを置いてあるフォルダ配下のみ表示させたいのですが無理なのでしょうか。 実行環境が９７なのが影響してるのでしょうか。 どなたか、お助けください。 以下、今試しているソースです。 Dim ShellApp As Object Dim oFolder As Object Dim MyPath As String MyPath = ActiveWorkbook.Path ChDir MyPath 'MyPathの中身が「C:\Documents and Settings\ABC\My Documents\業務」であることを確認 MsgBox (MyPath) Set ShellApp = CreateObject("Shell.Application") '直にパス指定すると、業務を先頭にその配下のフォルダ指定となる Set oFolder = ShellApp.BrowseForFolder(0, "処理ファイルの格納フォルダ選択", 1, "C:\Documents and Settings\ABC\My Documents\業務") 'MyPathがきいてない。デスクトップを先頭にその配下のフォルダ指定となる Set oFolder = ShellApp.BrowseForFolder(0, "処理ファイルの格納フォルダ選択", 1, MyPath)

  • フォルダ参照ではなくファイルを指定したい。

    フォルダの参照ダイアログボックスを使用して ファイルを選択できるようにしています。 プログラムでcsv形式で保存し、そのcsv形式ファイルを指定して開くという動作を目的としています。 そのファイル選択を固定でなく可変で選択したいと思っています。 Dim ShellApp As Object Dim oFolder As Object Set ShellApp = CreateObject("Shell.Application") Set oFolder = ShellApp.BrowseForFolder(0, "ファイル選択", &H4000,"C:\test") msgbox(oFolder) このような感じで、フォルダのみではなくファイルを指定することに成功しました。 しかし、このフォルダ参照ダイアログが表示されたときに、何も選択せずに キャンセルボタンをクリックするとエラーが出て止まってしまいます。 目的とする動作はできてはいるのですが、キャンセルするとエラーになるので、この原因がわからず困っています。 キャンセルボタンに関することを記述する必要があるのでしょうか？ また、この他にファイルを指定するのに適した方法がありましたら教えてください。 参照するフォルダを指定しているのでパスの取得は必要ありません。 ファイルが選択できたらOKです。 フォルダのパス取得のプログラムはよくサンプルを見かけるのですが、 ファイル選択のサンプルはあまり見かけないです(-_-;) また、この方法ではC:\と絶対パスで指定していますが、exeファイルが存在する場所からの相対パスでの指定はできないのでしょうか？ csvで保存する時は"./test/test.csv"などと記述して書き込みできていたのですが、 このようなパスを書くとエラーとなりファイルを見つけられないといわれてしまいます。

  • フォルダ内の全てのファイル開く時間短縮の方法

    Excelのマクロを使ってフォルダ内の全てのファイルを開く以下のコードを利用しているのですが（教えてgoo！で教えて頂いたコードです）、ファイル数が１０個くらいあるため全部開くのに１分くらいかかってしまいます。 もっと時間を短縮することはできませんでしょうか？ Sub OpenAllBook() 　　Dim FileName As String 　　Dim OpenedBook As Workbook 　　Dim IsBookOpen As Boolean 　　ChDir ("フォルダ名") 　　FileName = Dir("*.xls") 　　Do While FileName <> "" 　　　If FileName <> ThisWorkbook.Name Then 　　　　IsBookOpen = False 　　　　For Each OpenedBook In Workbooks 　　　　　If OpenedBook.Name = FileName Then 　　　　　　IsBookOpen = True 　　　　　　Exit For 　　　　　End If 　　　　Next 　　　　If IsBookOpen = False Then 　　　　　Workbooks.Open (FileName) 　　　　End If 　　　End If 　　　FileName = Dir() 　　Loop End Sub

  • テキスト文書(.txt)→エクセルにインポート

    エクセルから、テキスト文書(.txt)をインポートする機能を VBAで作成しているのですが、１つのセルに複数の行を 入力する方法がわからず、困っています。ご存知の方い らっしゃいましたら、ご教授よろしくお願いします。 ↓途中までのコードです。↓ Sub ボタン1_Click() Dim dir_name As String, file_name As String Dim rn As Integer dir_name = Application.GetOpenFilename( _ "テキストファイル (*.txt),*.txt", 1, _ "読み込み元のファイルをどれか一つ開いてください" _ ) If dir_name = "False" Then Exit Sub file_name = Dir("*.txt", vbNormal) rn = 1 ' 開始行 - 1 を設定 Do Until file_name = "" rn = rn + 1 Call ImportText(file_name, rn) file_name = Dir() Loop End Sub '------------------------------------------------------- Sub ImportText(file_name As String, rn As Integer) Dim FileNum As Integer Dim TextLine As String Dim cn As Integer FileNum = FreeFile() Open file_name For Input Access Read As #FileNum Application.StatusBar = "ファイル""" & file_name & """の内容を読み込んでいます。" On Error GoTo CloseFile Do Until EOF(FileNum) Line Input #FileNum, TextLine If cn < 6 Then cn = cn + 1 Cells(rn, cn).Value = Trim(TextLine) Else ★★★★★★★★★★★★★★★ End If Loop End Sub 『 ★★★★★★★★★★★★★★★』となっているところに、 Cells(rn, cn).Value = Trim(TextLine)　と書いて、１つのセル に残りの文章を全て入れようとしたのですが、このままでは上書 きされてしまい、最後の1行しか残っていません。 [例]残りの文字 こんにちは こんばんは おかえり。 ↓これをそのまま１つのセルに↓ こんにちは こんばんは おかえり。 と入れるには、どのような記述をすれば良いのでしょうか？ (Excel2007を使用しています。)

  • ファイル名がテキストボックスにうまく表示できない

    お世話になります。 filelistboxで選択したファイル名を選択した順に テキストボックスに表示させたいのですが、ファイル名の 後に改行コードを入れても改行して表示してくれません。 何が原因なんでしょうか？よろしく御教授願います。 例　aaa.txtを選択、テキストボックスに表示させ、 その後bbb.txtを選択するとテキストボックスの表示が ”aaa.txt‥bbb.txt”となる --------- aaa.txt（改行） bbb.txt --------- と表示したい。 （コード） Dim fname As String Private Sub File1_Click() fname = Dir1.Path & "\" & File1.FileName End Sub Private Sub Command3_Click() Call macappend End Sub Private Sub macappend() 'text1に選択マクロを追加 　　　Dim macbuff1 As String 　　　Dim macbuff2 As String 　　　macbuff2 = Text1.Text 　　　macbuff1 = fname + Chr(13) + Chr(11) 　　　macbuff2 = macbuff2 + macbuff1 　　　Text1.Text = macbuff2 End Sub

  • 複数テキストファイルをエクセルで開く

    度々の質問申し訳ございません。 複数のテキストファイルが入ったフォルダ内のすべてのテキストデータをエクセルの1シートで開きたいです。 他の方の同じような質問の御回答に以下のようなマクロが有りました。 Sub macro1() Dim myPath As String Dim myFile As String Dim n, c, s '初期化 myPath = ThisWorkbook.Path & "\" myFile = Dir(myPath & "*.txt") '受入準備 On Error Resume Next Worksheets.Add before:=Worksheets(1) ActiveSheet.Name = Format(Date, "yyyymmdd") On Error GoTo 0 'ファイルの巡回 Do Until myFile = "" n = n + 1 Cells(n, "A") = myFile 'データの読み出し Open myPath & myFile For Input As #1 c = 1 Do Until EOF(1) Line Input #1, s c = c + 1 Cells(n, c) = s Loop Close #1 myFile = Dir() Loop End Sub これを利用させていただいて、テキストファイルを開いたのですが、こちらのマクロですとテキストデータの1列目しか開く事が出来ません。（図参照） 1列目2列目共に開くには何処を変更すれば良いですか？ マクロはまったく理解できないので、何卒宜しくお願い致します。 また、できればエクセルの横方向に開くのではなく、縦方向に開けるようにして頂けると非常にありがたいです。 何卒宜しくお願い致します。

  • テキストファイルをエクセルに移すマクロのことで？

    以前、複数のテキストファイルをエクセルに移すマクロを教えてもらったのですが、 以下マクロですと、フォルダのパスを指定しないといけません。 今回教えてもらいたいのは、フォルダのパスを指定しなくてもよい方法です。 どういう事かと言うと、仮にディスクトップにフォルダがあるとします。 そのフォルダの中には、マクロが入っているエクセルシートとテキストが入っているフォルダです。 つまり、そのフォルダ内だけで、処理をしたいと考えています。 また、フォルダ名は、その時によって異なります。 今までは、以下の方法を使っていたのですが、ちょっと使いにくいと感じています。 申し訳ありませんが、どなたか教えていただけないでしょうか？ Sub Macro() Dim fso As Object Set fso = CreateObject("Scripting.FileSystemObject") Dim FolderPath As String 'ここのアドレスをファイルが格納されているフォルダのパスに変えてください FolderPath = "C:\Users\・・・" Dim myFile As Object Dim i As Long i = 2 Dim myFolder As Object For Each myFolder In fso.GetFolder(FolderPath).SubFolders For Each myFile In fso.GetFolder(myFolder).Files Cells(i, 4).Value = myFolder Cells(i, 1).Value = myFile.Name Cells(i, 7).Value = fso.OpenTextFile(myFile.Path).ReadAll() i = i + 1 Next Next End Sub Private Sub CommandButton1_Click() End Sub

  • VBS サブフォルダの再帰処理について

    VBScriptでファイルリストを出力しようと考えています。 そこでフォルダ内のファイルを再帰的に検索したいのですが、上手くいきません。 C:\A\B\C\D\○○.txt C:\A\BB\C\D\××.txt C:\A\BBB\C\D\△△.txt のようにB,BB,BBBの部分のみ可変にしたいのです。 例えば　C:\A\B\CC\D\○○.txt C:\A\B\CCC\D\○○.txt のような B以外のフォルダのサブフォルダについては再帰検索はいきたくありません。 （A,C ,D については引数で与えようと考えています。） よいロジックはないでしょうか？ ご存知の方がいらっしゃいましたらぜひ教えてください。 出力形式は ファイル名,作成日時 以下　色々参考にして作成したプログラム。 これだと指定フォルダ以下すべて検索にいってしまいます(-_-;) --------------------------------------------------------------- Dim fso Dim folder Set fso = CreateObject("Scripting.FileSystemObject") Dim pass pass ="C:\" & args.item(0) & "\" Dim subFolder For Each subFolder In folder.SubFolders ShowSubfolders FSO.GetFolder(pass) Next Sub ShowSubFolders(Folder) Dim file For Each file In folder.Files WScript.Echo _ file.Name & "," & _ file.DateCreated Next For Each subFolder In folder.SubFolders ShowSubFolders subFolder Next End Sub

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

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

質問する