VBS サブフォルダの再帰処理について

VBScriptでファイルリストを出力しようと考えています。
そこでフォルダ内のファイルを再帰的に検索したいのですが、上手くいきません。

C:\A\B\C\D\○○.txt
C:\A\BB\C\D\××.txt
C:\A\BBB\C\D\△△.txt

のようにB,BB,BBBの部分のみ可変にしたいのです。
例えば　C:\A\B\CC\D\○○.txt C:\A\B\CCC\D\○○.txt のような
B以外のフォルダのサブフォルダについては再帰検索はいきたくありません。
（A,C ,D については引数で与えようと考えています。）

よいロジックはないでしょうか？
ご存知の方がいらっしゃいましたらぜひ教えてください。

出力形式は
ファイル名,作成日時

以下　色々参考にして作成したプログラム。
これだと指定フォルダ以下すべて検索にいってしまいます(-_-;)
---------------------------------------------------------------
Dim fso
Dim folder
Set fso = CreateObject("Scripting.FileSystemObject")
Dim pass
pass ="C:\" & args.item(0) & "\"
Dim subFolder

For Each subFolder In folder.SubFolders
ShowSubfolders FSO.GetFolder(pass)
Next

Sub ShowSubFolders(Folder)

Dim file
For Each file In folder.Files
WScript.Echo _
file.Name & "," & _
file.DateCreated
Next
For Each subFolder In folder.SubFolders
ShowSubFolders subFolder
Next

End Sub

No.1 ベストアンサー 回答者： Gin_F 回答日時： 2007/04/05 22:12

＠IT：Windows TIPS -- Tips：ファイルの一覧情報リストを取得する

http://www.atmarkit.co.jp/fwin2k/win2ktips/310fi …

こちらが参考になると思います。

この回答への補足

早速ありがとうございます。

この例だと最下層まですべてのフォルダ検索してしまいますよね。
(例）
C:\A\B\C\D\○○.txt
C:\A\B\C\DD\○○.txt
C:\A\B\CC\E\○○.txt
C:\A\B\CC\EE\○○.txt

あるフォルダにあるサブフォルダのみ全検索。そのサブフォルダにあるフォルダについては固定で持たせるような方法がないでしょうか？

補足
＞C:\A\B\C\D\
＞A,C ,D については固定
と書きましたが、Dの下にあるフォルダについては全検索をしたいです。
C:\A\B\C\D\E
C:\A\B\C\D\EE
C:\A\B\C\D\EEE
のような感じです

よろしくお願いいたします。

補足日時：2007/04/06 08:43

No.4 回答者： Gin_F 回答日時： 2007/04/06 23:28

> あるフォルダにあるサブフォルダのみ全検索。

そのサブフォルダにあるフォルダについては固定で持たせるような方法がないでしょうか？

> strPath = InputBox("調べたいフォルダを絶対パスで入力してください。", "ファイル一覧", "c:\")

この起点となるフォルダの指定を

C:\A\B\C\
とすればいいのでは？

No.3 回答者： Bonjin 回答日時： 2007/04/06 23:22

暇つぶしに作ってみました。

こんな感じのやつでしょうか？
パターンは * で指定してください(複数指定可能)。
例) C:\A\*\C\D, C:\A\*\C\*

Option Explicit

Dim fso
Dim scanPath

Set fso = CreateObject("Scripting.FileSystemObject")
scanPath = WScript.Arguments(0)

ScanDirectory fso.GetDriveName(scanPath) & "\", Mid(scanPath, Len(fso.GetDrivename(scanPath)) + 1)

WScript.Quit 0

Sub ScanDirectory(ByVal dirPath, ByVal subDirPattern)
DebugPrint "dirPath : " & dirPath
DebugPrint "subDirPattern : " & subDirPattern

Dim dir
Dim subDir
Dim file
Dim nextDirPath
Dim nextSubDirPattern

If subDirPattern <> "" Then
' サブディレクトリパターンの指定がある場合
If InStr(1, subDirPattern, "*") > 0 Then
' パターンに * が含まれる場合

' 親ディレクトリのパスを取得(ex. C:\A\*\C -> C:\A)
nextDirPath = dirPath & Left(subDirPattern, InStr(1, subDirPattern, "*") - 1)
DebugPrint "Next dir path : " & nextDirPath

' 次のサブディレクトリパターンを取得(ex. C:\A\*\C -> \C)
nextSubDirPattern = Right(subDirPattern, Len(subDirPattern) - InStr(1, subDirPattern, "*"))
DebugPrint "Next sub dir pattern : " & nextSubDirPattern

If fso.FolderExists(nextDirPath) Then
Set dir = fso.GetFolder(nextDirPath)

' 次のサブディレクトリパターンを指定して検索
For Each subDir In dir.SubFolders
ScanDirectory subDir.Path, nextSubDirPattern
Next
Else
DebugPrint "Directory not found : " & nextDirPath
End If
Else
ScanDirectory dirPath & subDirPattern, ""
End If
Else
' サブディレクトリパターンが指定されていない場合

If fso.FolderExists(dirPath) Then
Set dir = fso.GetFolder(dirPath)

' ディレクトリ配下のファイルのパスを出力
For Each file In dir.Files
WScript.Echo file.Path & "," & file.DateCreated
Next

' サブディレクトリを再帰的に検索
For Each subDir In dir.SubFolders
ScanDirectory subDir.Path, ""
Next
Else
DebugPrint "Directory not found : " & dirPath
End If
End If
End Sub

Sub DebugPrint(ByVal message)
If False Then
WScript.Echo message
End If
End Sub

No.2 回答者： khazad-lefty 回答日時： 2007/04/06 16:37

正規表現でマッチングかけて、一致しなければ出力しないとか