Excelマクロでフォルダ内のCSVファイルを一括で読み込ませるには？

質問

Excelファイルと同階層にあるCSVファイルを読み込ませるマクロを作ってみたのですが、正常に動作しません。
アドバイスいただければ幸いです。
Excel2003を使用しています。

Sub 同階層フォルダ内のCSV読込_Click()

Dim fname As String 'ファイル名
Dim pathname As String 'パス名
Dim dat(1 To 4) As Variant '読み込んだデータ
Dim rr As Long '対象行番号
Dim i As Integer '列のオフセット
Dim j As Integer 'ファイル識別番号のオフセット

'同階層フォルダ内のCSVファイルを参照
pathname = ".\*.csv"
fname = Dir(pathname, vbNormal)

'データを挿入する行番号
rr = 2

'該当するファイルがある間
Do While fname <> ""

j = 0
j = j + 1

'ファイルを開く
Open fname For Input As #j
'ファイルの終端まで
Do Until EOF(j)
'データを取得
Input #j, dat(1), dat(2), dat(3), dat(4)
'読み込んだデータをセルに出力
For i = 1 To 4
Cells(rr, i).Value = dat(i)
Next

'行番号を更新
rr = rr + 1

Loop

Close #j

'フォルダ内の次のファイルを検索
fname = Dir()
Loop

End Sub

回答No.3

Wendy02 · ベストアンサー

こんにちは。

FileNo は、その都度閉じるのですから、FreeFile関数で、決めてあげれば、インクリメントする必要はありません。それから、私は、Line Input を使って、一行全体を取り入れて切り分けします。そのほうが速いからです。On Error があるのは、空行のためです。Dat()の配列を、String型にするのは、Excel側が勝手なキャストをしないためです。(Excel 2000以上)

なお、一部の変数名は変更しました。プロシージャ名も英語に変更しました。なるべく、変数は、キャメル形式にしたほうがエラーを見つけやすいです。

Sub OpenCSV_in_SameFolder_Click()
　 Dim Fname As String
　 Dim PathName As String
　 Dim StartRow As Integer
　 Dim FileNo As Integer
　 Dim TextLine As String
　 Dim i As Long
　 Dim Dat() As String
　 PathName = ThisWorkbook.Path & "\"
　 Fname = Dir(PathName & "*.csv")
　 StartRow = 2
　 Do While Fname <> ""
　 FileNo = FreeFile()
　　 Open PathName & Fname For Input As #FileNo
　　　 Do Until EOF(FileNo)
　　　　 Line Input #FileNo, TextLine
　　　　　　Dat() = Split(TextLine, ",")
　　　　　 On Error Resume Next
　　　　　　'4列目までなら、Resize(,4).Valueとする
　　　　　 Cells(StartRow + i, 1).Resize(, UBound(Dat()) - LBound(Dat()) + 1).Value = Dat()
　　　　　 i = i + 1
　　　　　 On Error GoTo 0
　　　Loop
　　　Close #FileNo
　　　Fname = Dir()
　 Loop
End Sub

補足

目から鱗です。
コードの書き方を変えるだけでこれだけ見やすくなるのですね。
コメントを入れなくても分かりやすいです。

Line Input を使うと汎用性が高いですね。
こちらを利用させていただきます。

ところで、ご提示いただいたコードで私の知識不足により理解できない点が２箇所あります。
もしよろしければ、こちらもお教えいただけませんでしょうか。

●Cells(StartRow + i, 1).Resize(, UBound(Dat()) - LBound(Dat()) + 1).Value = Dat()
　これの意味がよく分かりません。
　下記のコードと結果的に同じなのでしょうか？
　For i = 0 To UBound(Dat())
If Len(Dat(i)) <> 0 Then
Cells(StartRow, i + 1) = Dat(i)
End If
Next

●エラー処理の On Error Resume Next と On Error GoTo 0 を入れる場所ですが、
　この位置に入れる理由をお教えいただけませんでしょうか？

回答No.5

Wendy02

こんにちは。Wendy02です。

＞●エラー処理の On Error Resume Next と On Error GoTo 0 を入れる場所ですが、
＞　この位置に入れる理由をお教えいただけませんでしょうか？

(On Error があるのは、空行のためです。)とすでに書いてあったかと思いますが、配列にしても配列が空の場合は、エラーになりますので、それを避けるためです。

持ち込むデータが、何かわからない場合（この特定は、目視では分らないことがあります）、なかなかむつかしいのです。何であると、こちらで決めて掛かるわけにはいかないわけで、出力元を教えてもらうなどしてもらわないと、正確には出来ません。

コンマ区切り(CSV)なのか、タブ切りなのか、スペース区切りなのか、まだ他にも、バイナリタイプのものや、シーケンシャルファイルなど、それぞれに区切り方があります。それは、CSVは、今は、Excelの専売特許のようですが、どちらかというと、データベースソフトのためのものです。

#4 の　KenKey_SPさんの

2005/11/2,東京支店,田中,"\123,456"

の場合も、Line Input に変りませんが、Split関数の代わりに、サブルーチンで、切り分けて配列にします。私は、いままで、これを正規表現で切り分けてきましたが、Instr関数で切り分けることも可能です。

vbCR (\n) の場合は、経験したことがありませんので分りませんが、文書全体を、正規表現のループで切り分けることは可能だと思います。

お礼

ご返答いただきありがとうございます。
私の乏しい知識では理解できない部分もありますが、
これから疑問点を調べながら、いただいたアドバイスをモノにしていきたいと思います。
この度は誠にありがとうございました。

回答No.4

KenKen_SP

#2 です。

余談ですが、、

Split 関数や Line Input を使って CSV データのフィールド分割
を行う場合は、次のようなデータの読み込みに失敗しますので、
ご注意を。

例１）　2005/11/2,東京支店,田中,"\123,456"

　　　→2005/11/2　　東京支店　　田中　　"\123　　456"
　　　　ありがちですが、金額フィールドの桁区切りカンマとか。

例２）　キャリッジ リターン (vbCr)を含むフィールドがある
　　　　データ

　　　→1レコードがそのフィールドで複数のレコードに分割され
　　　　てしまいます。これが Line Input の特性です。
　　　　Excel でセル内改行のあるデータを CSV に書き出すと
　　　　このようなデータになります。

したがって、Line Input や Split 関数を使って CSV データを読み
込むコードを書く場合には、CSV ファイル内にこのようなデータが
含まれるかどうかを検証する必要があります。

お礼

例1は分かっておりましたが、例2は知りませんでした。
教えていただいて助かりました。
危うくトラブルに見舞われるところでした。

読み込ませたいデータを検証してから、Line Input を利用したいと思います。

貴重なアドバイスをありがとございます。

回答No.2

KenKen_SP

こんにちは。KenKen_SP です。

Dir 関数の戻り値はファイル名だけで、パスが含まれません。

Sub 同階層フォルダ内のCSV読込_Click()

　　Dim fname　　　 As String 'ファイル名
　　Dim pathname　　As String 'パス名
　　Dim dat(1 To 4) As Variant '読み込んだデータ
　　Dim rr　　　　　As Long '対象行番号
　　Dim i　　　　　 As Integer '列のオフセット
　　Dim j　　　　　 As Integer 'ファイル識別番号のオフセット

　　'同階層フォルダ内のCSVファイルを参照
　　pathname = ThisWorkbook.Path
　　fname = Dir(pathname & "\*.csv", vbNormal)

　　'データを挿入する行番号
　　rr = 2

　　j = 0
　　'該当するファイルがある間
　　Do While fname <> ""
　　　　j = j + 1
　　　　'ファイルを開く
　　　　Open pathname & "\" & fname For Input As #j
　　　　'ファイルの終端まで
　　　　Do Until EOF(j)
　　　　　　'データを取得
　　　　　　Input #j, dat(1), dat(2), dat(3), dat(4)
　　　　　　'読み込んだデータをセルに出力
　　　　　　For i = 1 To 4
　　　　　　　　Cells(rr, i).Value = dat(i)
　　　　　　Next
　　　　　　'行番号を更新
　　　　　　rr = rr + 1
　　　　Loop
　　　　Close #j
　　　　'フォルダ内の次のファイルを検索
　　　　fname = Dir()
　　Loop

End Sub

お礼

Dir 関数の戻り値はファイル名だけなのですね。
大変勉強になりました。

ご提示いただいたコードで、正常に動作するようになりました。
ありがとうございました。

回答No.1

wuyan

とりえず、j = 0 は Do ループの中ではなく外 (前) に出すこと

お礼

見落としていました。
ご指摘ありがとうございます。