こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

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

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

1フォルダに数十のログファイル(.txt)が格納されています。
1ファイルは3~5万行記述あります。
これを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で作成されたシートからの集計マクロについては完成していますが、
その手前でつまづいています><
ご教授のほどお願い致します><

投稿日時 - 2011-04-24 01:31:11

QNo.6689790

困ってます

質問者が選んだベストアンサー

#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

投稿日時 - 2011-04-25 22:36:27

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(5)

ANo.5

ご苦労様です。

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

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

投稿日時 - 2011-05-12 20:59:01

お礼

助かりました^^ありがとうございます><

投稿日時 - 2011-09-04 01:43:58

ANo.3

この手の事は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

投稿日時 - 2011-04-24 11:05:21

補足

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

投稿日時 - 2011-04-24 22:36:10

ANo.2

質問の説明が丁寧なのは良いが、くどくてわかりにくい面もある。
課題は単純で
(1)1フォルダのファイル(名)を順次掴む
(2)(1)のファイルのレコードを順次読んで1つにまとめるなり、エクセルのセルに書き出す
それだけでしょう
(1)のコードはWEBに満ち溢れている
なんでGoogleででも「VBA フォルダ ファイル名 取得」などで照会しないのか。
http://itpro.nikkeibp.co.jp/article/COLUMN/20060120/227645/ (FSOの例)ほか多数
それと、質問者は、テキストファイルを扱うVBAに慣れていないのだろう。昔のBasic時代は、何をするにもここから始まったのだが。
ーー
下記例では配列に3つのテキストファイルを指定し、エクセルに書き出している例。3つぐらいの例で勉強したり、テストしたり、質問すれば、後は考えを延長すれば仕舞いなのだ。質問には実際をややこしく説明するのは無駄。
下記例を質問者の場合、FSOのFor Eachで、フォルダの中の1ファイルを捕まえたとき、
そのファイルを見つける繰り返しの中で見つかった場所(コード上の)へ、下記のOpenからCloseまでを入れ子にすればしまい。
その時点ではもちろん、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
これはインプトファイルの1行=>アウトプットファイルの1行の集積なので、必要があれば、エクセルの「区切り位置」操作で
各フィールド(=列項目)に分けることも出来る。
一旦上記例の"textx.txt"に当たる集積テキストファイルを作って、最後にエクセルに読ませる手もある。

投稿日時 - 2011-04-24 10:41:11

お礼

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

投稿日時 - 2011-04-24 22:02:02

ANo.1

フォルダ内のファイル名などの情報を取得する方法の一つとして
Dir()関数で調べてみると たくさんヒットします。
一例ですが、新しいシートで
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
の部分に
>単一ファイルの読み込み/ファイル名をシート名に付与/情報コピペ/ファイル閉じについては、
作成できたのですが
のコードを順次実行させるように置き換えます。

投稿日時 - 2011-04-24 07:52:53

補足

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

投稿日時 - 2011-04-24 22:40:26

あなたにオススメの質問