複数フォルダに格納されたファイル名取得VBA

お世話になっております。

あるフォルダに複数のフォルダが格納されており、更にそのフォルダの中にあるファイルの情報を取得するプログラムを書いたのですが、実行すると下記のようなエラーとなってしまいます。

■エラー
プロシージャの呼び出し、または引数が不正です

下から3行目、「buf = Dir()」が問題であることはわかるのですが、
何が問題でどのように解決したらいいかわかりません。

どなたかご教授の程よろしくお願い致します(>_<)

------------------------------------------------------------------------
Sub test()

Dim buf As String
Dim fName As String
Dim msg As String

buf = Dir("*.*", vbDirectory)

Do While buf <> ""
If GetAttr(buf) And vbDirectory Then
If buf <> "." And buf <> ".." Then
fName = Dir(CurDir & "\" & buf & "\" & "*.jpg")
Do While fName <> ""
cnt = cnt + 1
Cells(cnt, 1) = buf
Cells(cnt, 2) = fName
msg = msg & buf & "\" & fName & vbCrLf
fName = Dir()
Loop
MsgBox msg

End If
End If
buf = Dir()
Loop

End Sub
------------------------------------------------------------------------

これが実現できないと細かい作業を毎日繰り返す事となり、
かなり業務不可が高いです。。

繰り返しになってしまいますが、どなたかご回答よろしくお願い致します。

No.3 ベストアンサー 回答者： uruz 回答日時： 2014/01/22 19:11

エラーの理由はNo2さんが回答していますので.....

Dir()関数は入れ子にできないのでフォルダの取得とファイルの取得を別々に考えます。
まずフォルダのみを収集しそのフォルダ内のファイルを取得します。

例：(見やすくするために全角スペースでイデントしています)
Sub test2()
　Dim buf As String
　Dim fName As String
　Dim msg As String
　Dim AA() As String
　Dim i As Long

　'フォルダの取得
　ReDim AA(0)
　buf = Dir("*.*", vbDirectory)
　Do While buf <> ""
　　If GetAttr(buf) = vbDirectory Then
　　　If buf <> "." And buf <> ".." Then
　　　　ReDim Preserve AA(UBound(AA) + 1)
　　　　AA(UBound(AA)) = buf
　　　　Cells(UBound(AA), 3) = buf
　　　End If
　　End If
　　buf = Dir()
　Loop

　'ファイルの取得
　For i = 1 To UBound(AA)
　　fName = Dir(CurDir & "\" & AA(i) & "\" & "*.jpg")
　　Do While fName <> ""
　　　cnt = cnt + 1
　　　Cells(cnt, 1) = AA(i)
　　　Cells(cnt, 2) = fName
　　　msg = msg & buf & "\" & fName & vbCrLf
　　　fName = Dir()
　　Loop
　　MsgBox msg
　Next i

End Sub

この回答へのお礼

ご回答ありがとうございます！
まさにやりたいことが実現できました(^O^)

お礼日時：2014/01/23 20:45

No.2 回答者： neKo_deux 回答日時： 2014/01/22 17:19

VBAのヘルプ、Dir関数の説明にある、

| 一致するファイル名がない場合は、Dir 関数は長さ 0 の文字列を返します。長さ 0 の文字列が返された場合は、次に Dir 関数を呼び出すときに引数 pathname を再び指定しなければなりません。指定しないとエラーが発生します。

の通りのエラーです。

ループの中で、
fName = Dir()
が空白になった際、内側のループを抜けた後の、
buf = Dir()
がエラーになります。

Dir関数は入れ子にして使う、再帰的に呼び出すなんかの場合は、ちょっと工夫が要るかも？

DIR関数 - Visual Basic - 教えて！goo
http://oshiete.goo.ne.jp/qa/3040393.html

No.1 回答者： papapa0427 回答日時： 2014/01/22 17:09

そりゃそうでしょう。

かなり間違った解釈をされています。
＞buf = Dir("*.*", vbDirectory)
bufはstring型ですから、一つのファイル名しか入りませんよ。
それに複数のファイル名を入れようとしているんですからエラーになって当然ですね。

＞Do While buf <> ""
この解釈も同様の誤りに起因しています。

まずはファイル名を一つ一つ取り込むプログラムを書かれてはいかがでしょう。
ここでこういう風にプログラム書いたら良いよってのは匿名でやっている関係上責任持てませんので出来ません。あくまでも自助努力のお助けをするだけです。

この回答へのお礼

早々のご回答ありがとうございました。
ファイル名を一つずつ取り込むところはできたんですけど、
それを全フォルダでって言うところが難しくて・・・

お礼日時：2014/01/23 20:42