VBAでアクティブなファイルを参照して、ファイル一覧作成（サブフォルダ含む）

質問

VBAでアクティブなファイルのフォルダ（サブフォルダを含む）のファイル一覧を
作成したいと思っています。
以下のサイトを参考にして、パス、ファイル名を落とすまではできました。

http://okwave.jp/qa3544575.html

===
Sub test()

Application.ScreenUpdating = False

Sheet1.Cells.Clear
Sheet1.Cells(1, 1) = "パス"
Sheet1.Cells(1, 2) = "ファイル名"

files "d:\", 2

Application.ScreenUpdating = True

End Sub

Sub files(path As String, ByRef row As Long)
DoEvents
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim f As Object

For Each f In fso.GetFolder(path).files
Sheet1.Cells(row, 1) = path
Sheet1.Cells(row, 2) = f.Name
row = row + 1
Next

For Each f In fso.GetFolder(path).SubFolders
files f.path, row
Next
Set fso = Nothing

End Sub

===

>files "d:\"
の箇所を修正して、アクティブなブックを参照しようとしてみたのですが、
なかなか上手くいきません。
また、できれば　*.xls　などファイルの種類を指定したいのです。

filesearchを使用して組んだ時は
「AAA = ActiveWorkbook.path」「Filetype　～　」
などでそれらの指定ができたのですが、上記に応用する事ができません。

どなたかご教示頂けますよう、よろしくお願いいたしますm(_ _)m

回答No.1

fumufumu_2006 · ベストアンサー

>アクティブなファイル
と言うのがわからないのですが、filesearchはoffice2007で廃止になったそうです。
http://support.microsoft.com/kb/935402/ja

で、FileSystemObjectかdirで求めるのが良いと思い、dirに書き換えてみました。
ところが、何故かエラーが出ます。
調べたら、丸の中にRみたいな特殊な文字でエラーしているようなので、あきらめました。
と言うわけで、ワイルドカードではありませんが、拡張子(と言うか、右側の文字)で選択できるようにしました。

Sub test()
Sheet1.Cells.Clear
Sheet1.Cells(1, 1) = "パス"
Sheet1.Cells(1, 2) = "ファイル名"
files "D:\", 2, ".xls"
MsgBox "終了"
End Sub

Sub files(path As String, ByRef row As Long, mask As String)
DoEvents
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim f As Object
For Each f In fso.GetFolder(path).files
If UCase(Right(f.Name, Len(mask))) = UCase(mask) Then
Sheet1.Cells(row, 1) = path
Sheet1.Cells(row, 2) = f.Name
row = row + 1
End If
Next
For Each f In fso.GetFolder(path).SubFolders
files f.path, row, mask
Next
Set fso = Nothing
End Sub

お礼

なるほど、そちらに付ければよろしいのですね。
初心者のため右往左往しておりますが、勉強になりました^^
ありがとうございました。