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

回答No.4

Prome_Lin · ベストアンサー

ウッ、ファイル名にカンマ。

カンマを削除してしまうのでしたら、

myFile = Replace(myFile, "," "")

で、削除できますし、あとは、ファイル名の前後に「"」（ダブルクォーテーション）を入れてやる方法はどうでしょう？

Print #1, s & "," & Chr(34) & myFile & Chr(34)

これで、できた「csv」ファイルを読み込んだとき、ひとまとまりになります。

お礼

御親切に対応ありがとうございます。しかしながらmyFile...やPrint#1をどこに挿入したらいいのかわからず困っております。
迷惑を再度おかけすることになりますが、全体のコードを教えてはいただけないでしょうか。
よろしくお願いします。

回答No.5

Prome_Lin

回答No.2です。

私のプログラムの場合でしたら、

Sub Test()
Set s = CreateObject("Scripting.FileSystemObject")
Set f = s.GetFolder("D:\Programming\Backup\OK_05")
Set t = s.OpenTextFile(f & "\Total.csv", 2, True)
For Each c In f.Files
If LCase(s.GetExtensionName(c.Name)) = "csv" And c.Name <> "Total.csv" Then
Set x = s.OpenTextFile(f & "\" & c.Name)
Do Until x.AtEndOfStream
a = x.ReadLine
t.WriteLine a & "," & Chr(34) & c.Name & Chr(34)
Loop
x.Close
Set x = Nothing
End If
Next
t.Close
Set t = Nothing
Set f = Nothing
Set s = Nothing
End Sub

というように、

t.WriteLine a & "," & Chr(34) & c.Name & Chr(34)

の部分です。

質問者のプログラムでしたら、

Print #1, s & "," & Chr(34) & myFile & Chr(34)

の部分ですね。

回答No.3

Prome_Lin

回答No.2です。

こちらこそ、すみませんでした。

それでは、１行ずつ、読み込んで、書き込まないといけませんでしたね。

Sub Test()
Set s = CreateObject("Scripting.FileSystemObject")
Set f = s.GetFolder("D:\Programming\Backup\OK_05")
Set t = s.OpenTextFile(f & "\Total.csv", 2, True)
For Each c In f.Files
If LCase(s.GetExtensionName(c.Name)) = "csv" And c.Name <> "Total.csv" Then
Set x = s.OpenTextFile(f & "\" & c.Name)
Do Until x.AtEndOfStream
a = x.ReadLine
t.WriteLine a & "," & c.Name
Loop
x.Close
Set x = Nothing
End If
Next
t.Close
Set t = Nothing
Set f = Nothing
Set s = Nothing
End Sub

変えたのは、

Do Until x.AtEndOfStream
a = x.ReadLine
t.WriteLine a & "," & c.Name
Loop

の部分ですが、ご覧になって頂ければ分かるように、１行ずつ読み込んで、書き込む際に、「,」と「ファイル名」を足しています。

それと、「Cells～」はもちろん、不要になりましたので、関係する部分は削除しています。

質問者のマクロの場合でしたら、

Print #1, s & "," & myFile

ですね（念のため、私、質問者のマクロは試していませんが）。

お礼

早速ありがとうございました。
しかし残念なことにファイル名にカンマが含まれているためにcsvのファイル名が分解されて保存されていました。
何とかここを一つの情報として保存は出来ないものでしょうか。
csv様式の制約ならあきらめます。

回答No.2

Prome_Lin

すみません、私のいつものやり方で書き直してしまいました。

Sub Test()
Set s = CreateObject("Scripting.FileSystemObject")
Set f = s.GetFolder("D:\Programming\Backup\OK_05")
Set t = s.OpenTextFile(f & "\Total.csv", 2, True)
r = 0
For Each c In f.Files
If LCase(s.GetExtensionName(c.Name)) = "csv" And c.Name <> "Total.csv" Then
r = r + 1
Cells(r, 1).Value = c.Name
Set x = s.OpenTextFile(f & "\" & c.Name)
a = x.ReadAll
t.Write a
x.Close
Set x = Nothing
End If
Next
t.Close
Set t = Nothing
Set f = Nothing
Set s = Nothing
End Sub

簡単な説明です。

Set s = CreateObject("Scripting.FileSystemObject")

ファイルやフォルダを扱えるようにしています。

Set f = s.GetFolder("D:\Programming\Backup\OK_05")

フォルダを取得しています（質問者の環境に合わせてください）。

Set t = s.OpenTextFile(f & "\Total.csv", 2, True)

書き込み用で、「Total.csv」ファイルを作成しています。

r = 0

行カウント用。

For Each c In f.Files

上記で取得したフォルダの中のすべてのファイルを処理。

If LCase(s.GetExtensionName(c.Name)) = "csv" And c.Name <> "Total.csv" Then

見つけたファイルの拡張子が「csv」で、なおかつ「Total.csv」ファイルでない場合、
（「LCase()」で拡張子を半角に統一しています）

r = r + 1

行カウント。

Cells(r, 1).Value = c.Name

列「A」に順番にファイル名を記入。

Set x = s.OpenTextFile(f & "\" & c.Name)

見つけた「csv」ファイルを開いています。

a = x.ReadAll

一気に、ファイルの内容を読み込んでいます。

t.Write a

読み込んだファイルの内容を「Total.csv」ファイルに書き込んでいます。

x.Close

開いた「csv」ファイルを閉じています。

という具合です。

質問者のマクロの場合ですと、「myFile」にファイル名が入っているのではないでしょうか？

したがって、「myFile」を、私のように「Cells(r, 1).Value = myFile」とすればいいのでは？

ただし、質問者のマクロは試していませんのでご自分ご確認ください。

質問者のやり方の場合、１行ずつ読み込むのに対して、私のやり方だと、ファイルの内容を、一気に全部読み込んでしまいますので、もし、行数の多い「csv」ファイルを、それなりに大量に扱われる場合は、私の方が有利だと思います。

お礼

どうもありがとうございます。
早速試したのですが「コンパイルエラー:変数が定義されていません。」が出てしまいます。VBA初心者の為自己解決が出来ないため、ご教示いただけないでしょうか。

補足

大変失礼しました。Option Explicitを削除すれば回避できることがわかり実行できました。
しかし私の意図とは違う結果になってしまいました。説明が不足していたようでご迷惑をおかけしました。
「シートの右端に読み取ったファイル名を追加」とはそれぞれのcsvファイルから読み取ったデータの右端（列の最後）に各々のファイル名を差し込みたいという意味でした。それぞれのデータがどのファイルから取ったものかわかるようにしたいのです。

回答No.1

imogasi

＞これにシートの右端に読み取ったファイル名を追加するにはどうしたらよいでしょうか。
この意味が不明確。
本当は、例でも挙げて質問のこと。
ーー
文字情報だけのレコード形式データを合体するには
（１）エクセルシート上で最終行の次行から下に、追加をおこなう
その後ＣＳＶファイルで保存。
（２）テキストファイルのＣＳＶ形式のものを、ＣＳＶ形式（レコード式）のOUTPUTファイルに、レコード的に順次追加していく
方法が考えられる。
本件は（２）なのだろうが、（１）の方法ならば、こんな質問は出ないだろう。
ーー
最近では、エクセルで読み込んだり、エクセルをＣＳＶファイルに保存したりするのは、見てくれ的に自動でやってくれるので、こういう質問が出るのだろうが、ＣＳＶファイルの
仕組みを勉強すれば、おのずとわかることではないか。
（１）どのタイミングでレコードを挿入するのか
（２）フィールド的（エクセルで言えば列記号）に何番目か
が質問では、明確でない。質問が大雑把。
初期設定の部分と
Do Until EOF(2)
Line Input #2, s
Print #1, s
Loop
のループはいる前に、これから読むＣＳＶファイルのファイル名の文字列をＣＳＶファイル（本件では＃１か）アウトプットすればよい。
列挿入に当たるのは、空白列をいれるとして",,"を空白列の数だけ、挟めばよい。
１行に当たる、そういう文字列を作って書き出せばよい。
ーー
参考
エクセルに毒されていない人は
ファイル名のレコード追加がない売は
コマンドプロンプトのＡＰＰＥＮＤでテキストファイルが合体できると思う。
http://www.adminweb.jp/command/redirect/index2.html　など