特定フォルダ内のサブフォルダを全てチェックし、指定したものを削除する方法について

お世話になります。
標記の件につきまして、自己解決がどうしてもできませんでしたのでご教示いただけないでしょうか。

VBScriptを使用して、Ａというフォルダに格納されているサブフォルダを全てチェック（検索）し、指定した条件に該当するものを削除したいのです。
条件は以下の通りです。

〇Ａフォルダ直下には、Ｂフォルダ、Ｃフォルダ、Ｄフォルダ・Ｅフォルダ・Ｆフォルダが存在している。
〇Ｂ・Ｃフォルダ直下には「yyyy_mm_dd」（作成日日付）という名前でフォルダが作成されている。
〇Ｄフォルダ直下にはＧフォルダ・Ｈフォルダが存在し、Ｇ・Ｈフォルダ直下に「yyyy_mm_dd」（作成日日付）という名前でフォルダが作成されている。
〇Ｅ・Ｆフォルダ直下にはファイルのみ存在し、フォルダは存在しない。

この条件の時、それぞれのフォルダ内にある「yyyy_mm_dd」（作成日日付）フォルダのうち今日の日付から90日以上前の作成日日付フォルダを削除したいのです。
ご教示いただきたいのは

サブフォルダ内のサブフォルダ、サブフォルダ内のサブフォルダ内のサブフォルダをチェックするロジック
「yyyy_mm_dd」（作成日日付）フォルダと今日の日付の差を求めて削除するロジック

上記の2点です。

なお、Ａ～Ｈのフォルダは削除せずそのまま残しておきたいです。
質問する場が違うかもしれませんがご教示いただけますと幸いです。
よろしくお願いいたします。

投稿者です。
バージョン情報が不足していましたので追記いたします。

当方、Win7、WindowsServer2008を使用しております。

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

こんな感じでしょうか？

Option Explicit



Dim objFSO

Dim Folder

Dim SubFolders

Dim reg



Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")



Set reg = New RegExp

reg.Pattern = "^(\d{4})_(\d{2})_(\d{2})$"



Set Folder = objFSO.GetFolder("A")

SubFolderParse Folder





Sub SubFolderParse(Folder)

    Dim SubFolder

    Dim PathName

    Dim CreateDate



    PathName = Folder.Name

    if reg.Test(PathName) then

        CreateDate = DateValue(reg.Replace(PathName,"$1/$2/$3"))

        WScript.Echo Folder.Path & ":" & DateDiff("d",CreateDate,Date)

        If DateDiff("d",CreateDate,Date) >= 90 then

            Folder.Delete True

        End If

    Else

        Set SubFolders = Folder.SubFolders



        For Each SubFolder in SubFolders

            SubFolderParse(SubFolder)

        Next

    End if

End Sub

> 条件は以下の通りです。
Ｅ・Ｆの下にあるファイルの仕様が不明ですが、こんな感じですか?




> サブフォルダ内のサブフォルダ、サブフォルダ内のサブフォルダ内のサブフォルダをチェックするロジック
FileSystemObject を使って処理するのであれば、Foler オブジェクトの SubFolder プロパティを
再帰的に処理していけば良いかと。

> 「yyyy_mm_dd」（作成日日付）フォルダと今日の日付の差を求めて削除するロジック
それでも求められますが、「今日の 90 日前の日づけ」を DateAdd 等で求めておき、
それを yyyy_mm_dd 化したものと大小比較した方がてっとり早い気がします。



以下、未検証ですがイメージコード。

"yyyy_mm_dd" 以外の命名規約のファイルがあった場合や、
アクセス権がらみのエラー対処などは盛り込んでいません。

Option Explicit



Call Main()



Sub Main()

  Dim limit

  limit = GetLimit()    ' = "2001_12_31" など。これより古いファイルを削除する。 



  Dim fileList, fso

  Set fileList = CreateObject("Scripting.Dictionary")

  Set fso = CreateObject("Scripting.FileSystemObject")



  Dim filePath  ' ここに、削除すべきファイル名の一覧が格納される 

  AddDeleteFiles fileList, fso.GetFolder("C:\temp\"), limit



  '列挙したファイルを削除する 

  For Each filePath In fileList.Keys   '.Keys → .Items でも可 

    fso.DeleteFile filePath, False

  Next

End Sub



Function GetLimit()

  Dim dt

  dt = DateAdd("d", -90, Date)    '90日前の日づけ 

  Dim ymd

  ymd = CStr(Year(dt) * 10000 + Month(dt) * 100 + Day(dt))

  '"20011231"を、"2001_12_31" 形式に変換 

  GetLimit = Mid(ymd, 1, 4) & "_" & Mid(ymd, 5, 2) & "_" & Mid(ymd, 7, 2)

End Function



Sub AddDeleteFiles(ByVal oDict, ByVal parentFolder, ByVal limit)

  Dim oFolder, oFile

  For Each oFolder In parentFolder.SubFolders

    AddDeleteFiles oDict, oFolder, limit

  Next

  For Each oFile In parentFolder.Files

    If oFile.Name <= limit Then

      oDict.Add oFile.ShortPath, oFile.Path

    End If

  Next

End Sub

投稿者です。

shuさま、魔界の仮面弁士さま、ご回答いただきありがとうございます。

shuさまの方法で希望する処理を行うことが出来ました。

お二人からご教示いただいたコードをさらに自分なりに検証して、理解できるようにしたいと思います。

お忙しいところをありがとうございました。