フォルダ内全ファイルをシート毎に貼付方法について

質問

VBA仙人様ご教授お願い致します。

１フォルダに数十のログファイル（.txt)が格納されています。
1ファイルは３～５万行記述あります。
これを１つのExcelファイルにしたいと思っています。

VBA流れとして
(1)ログ格納フォルダを選択
(2)ログファイル名を取得
(3)既存Excelファイルに(2)で取得したファイル名（.txt除いた）で順次シートを追加
(4)ログファイル＝シートとなるようにファイル読み込み/貼り付け
(5)ログファイルを閉じる

VBAイメージ
格納フォルダ：C:\test
\test内　　　 ：A001.txt,A002.txt,B003.txt・・・・・・・・Z051.txt（このフォルダにはログのみ格納）
C:デスクトップ\集計マクロ.excel (VBAの記述のあるExcelシートにはSheet1のみが存在)

VBA前
集計マクロ.excel/Sheet1
VBA実行後
集計マクロ.excel/Sheet1,A001,A002,B003,D004・・・・・・・・・Z051が追加、シート毎にログ情報記載

単一ファイルの読み込み/ファイル名をシート名に付与/情報コピペ/ファイル閉じについては、
作成できたのですが、複数ファイルの場合のファイル名を順次取得し、シート名として付与するなど
objやValiant変数などで試行錯誤しましたが解決できず、こちらに質問されていただきました＞＜
このVBAで作成されたシートからの集計マクロについては完成していますが、
その手前でつまづいています＞＜
ご教授のほどお願い致します＞＜

回答No.4

mitarashi · ベストアンサー

#3です。
Set destRange = sh.Range("A1").Resize(UBound(buf) + 1, 1)
が正しいです。試験したファイルは最後にもCrLfが入っていたため、見落としてしまい申し訳ありません。
改行コードCrLfが一個も入っていないファイルの場合、UBound(buf)が0となるため、ご指摘のエラーになります。

また、行の区切りがCrLfでない場合は、
Const delimiter As String = vbCrLf
の所を、vbLfなのか、その他の任意の文字か分かりませんが、それに変更する必要があります。

行の区切りと、セルの区切りがある場合は、下記の様にできると思います。ただし、すべての行の要素数が同じとします。
buf = Split(textFile.ReadAll, delimiter)
buf2 = Split(buf(0), cellDelimiter)
Set destRange = sh.Range("A1").Resize(UBound(buf) + 1, UBound(buf2) + 1)
For i = 0 To UBound(buf)
destRange.Rows(i + 1) = Split(buf(i), cellDelimiter)
Next i

回答No.5

ZExcel

ご苦労様です。

単一ファイルでできたのであれば、それをループさせるだけだとは思いますが、
Excelで複数ファイルを立ち上げて「終了」させるにはきちんとExcelオブジェクトを順に終了させていかなければ
できないことがあります。
そのためにはExcelオブジェクトのApp→workbook→worksheet→cellとアクセスし、終了させるときはその逆に終了させていく
（オブジェクトを解放する）ようにしなければExcelが終了しません。

やりたいことはテキストファイルの合体だと思うのですが、既にツールがあります。

お礼

助かりました＾＾ありがとうございます＞＜

回答No.3

mitarashi

この手の事はFileSystemObjectを使うと便利です。詳細は参照URLをご覧下さい。
ファイルリスト取得はDirでも良いのですが、全部FSOでやってみました。
xl2000で試しています（少数＆小さなファイルですが．．．）。ご参考まで。
Sub treatAllFiles()
Dim FSO As Object, targetFolder As Object, targetFile As Object
Dim textFile As Object
Dim folderName As String
Dim sh As Worksheet
Dim destRange As Range
Dim buf As Variant
Const delimiter As String = vbCrLf

folderName = "C:\test"
Set FSO = CreateObject("Scripting.FileSystemObject")
Set targetFolder = FSO.getfolder(folderName)
For Each targetFile In targetFolder.Files
DoEvents '途中でやめたくなった時のための保険
If UCase(FSO.GetExtensionName(targetFile)) = "TXT" Then
Set sh = ThisWorkbook.Sheets.Add
sh.Name = FSO.getbasename(targetFile)
Set textFile = FSO.OpenTextFile(targetFile)
'この部分は速いかなと思って少々奇を衒ってみましたが、メモリ容量上問題が出る場合は、ReadLineで一行ずつ読みこんで処理してください。一行を一つのセルに収納する前提です。複数に分ける場合は、追加の処理が必要です。
buf = Split(textFile.ReadAll, delimiter)
Set destRange = sh.Range("A1").Resize(UBound(buf), 1)
destRange = Application.Transpose(buf)
Set textFile = Nothing
End If
Next targetFile
Set FSO = Nothing
End Sub

参考URL：

http://officetanaka.net/excel/vba/filesystemobject/index.htm

補足

ご教授有難うございます。
ご提供いただいたマクロについて一日解読致しました。
私が途中まで自力で作成したものはとてつもない行数のものでした・・・
実データにて検証致しましたが、マクロ内Set destRange = sh.Range("A1").Resize(UBound(buf), 1)のフォルダ内最初のファイル名でシートが作成されたところでで”オブジェクト定義エラー”となりマクロが停止してしまいました。
テキストログ内にはExcelで区切りせりできるよう、Shellでテキスト内にブランクを挿入して分割しています。これがspilt処理の際に支障となり本件のエラーになっているのでしょうか？
引き続きデバッグを試みますが、mitarashiさん方で原因が分かればお時間あるときに教えてください。よろしくお願いします。

回答No.2

imogasi

質問の説明が丁寧なのは良いが、くどくてわかりにくい面もある。
課題は単純で
（１）１フォルダのファイル（名）を順次掴む
（２）（１）のファイルのレコードを順次読んで１つにまとめるなり、エクセルのセルに書き出す
それだけでしょう
（１）のコードはＷＥＢに満ち溢れている
なんでＧｏｏｇｌｅででも「ＶＢＡ　フォルダ ファイル名 取得」などで照会しないのか。
http://itpro.nikkeibp.co.jp/article/COLUMN/20060120/227645/　（ＦＳＯの例）ほか多数
それと、質問者は、テキストファイルを扱うＶＢＡに慣れていないのだろう。昔のＢａｓｉｃ時代は、何をするにもここから始まったのだが。
ーー
下記例では配列に３つのテキストファイルを指定し、エクセルに書き出している例。３つぐらいの例で勉強したり、テストしたり、質問すれば、後は考えを延長すれば仕舞いなのだ。質問には実際をややこしく説明するのは無駄。
下記例を質問者の場合、ＦＳＯのＦｏｒ　Ｅａｃｈで、フォルダの中の１ファイルを捕まえたとき、
そのファイルを見つける繰り返しの中で見つかった場所（コード上の）へ、下記のＯｐｅｎからＣｌｏｓｅまでを入れ子にすればしまい。
その時点ではもちろん、f = Array("test01.txt", "test02.txt", "text7.txt")　は不要。
ーーー
Sub test01()
f = Array("test01.txt", "test02.txt", "text7.txt")
i = 1
Open "textx.txt" For Append As #2
For Each fl In f
Open fl For Input As #1
While Not EOF(1)
Line Input #1, a
Print #2, a
Cells(i, "A") = a
i = i + 1
Wend
Close #1
Next
Close #2
End Sub
これはインプトファイルの１行＝＞アウトプットファイルの１行の集積なので、必要があれば、エクセルの「区切り位置」操作で
各フィールド（＝列項目）に分けることも出来る。
一旦上記例の"textx.txt"に当たる集積テキストファイルを作って、最後にエクセルに読ませる手もある。

お礼

ご教授ありがとうございます。
精進いたします＞＜

回答No.1

hallo-2007

フォルダ内のファイル名などの情報を取得する方法の一つとして
Diｒ（）関数で調べてみると　たくさんヒットします。
一例ですが、新しいシートで
A1セルに　C:\test　とフォルダを指定しているとして

Sub Sample1()
Dim buf As String, i As Long
i=6
buf = Dir(Range("A1").Value & "\*.txt")
Do While buf <> ""

Cells(i + 1, 1).Value = buf
i = i + 1

buf = Dir()
Loop
End Sub

を試してみてください。
この部分が理解できたら
Cells(i + 1, 1).Value = buf
i = i + 1
の部分に
＞単一ファイルの読み込み/ファイル名をシート名に付与/情報コピペ/ファイル閉じについては、
作成できたのですが
のコードを順次実行させるように置き換えます。

補足

ご回答有難うございます。
今回の構文を私のマクロに取り入れて試行しておりますが、未だ解決できずです。少し頑張って解決してみます。