【VBS】古い日付のフォルダを削除したい

質問

あるフォルダ（C:\test\）内のフォルダ名が日付形式（YYYYMMDD）のものの中で、
一番新しい日付のフォルダを残し、古い日付のフォルダを削除したいです。

日付が新しいか古いかは、フォルダ名で判断。作成日時で判断するのではない。

C:\test\フォルダには、日付形式（YYYYMMDD）のフォルダとそれ以外の名称のフォルダ、ファイルが含まれます。

例ですが、C:\test\フォルダに以下のフォルダ・ファイルがあるとして、
C:\test\AbcD1\
C:\test\20130601\
C:\test\20130611\
C:\test\Aiueo2\
C:\test\aa2.log
C:\test\20130602\
C:\test\20130605\
C:\test\20130614\
C:\test\Zxy2\
C:\test\aaa.txt

削除するのは、
C:\test\20130601\
C:\test\20130611\
C:\test\20130602\
C:\test\20130605\
です。

以下のフォルダについては、フォルダ名が日付形式（YYYYMMDD）ではないので、
削除しません。
C:\test\AbcD1\
C:\test\Aiueo2\
C:\test\Zxy2\

以下のフォルダについては、フォルダ名の日付が最新のため、
削除しません。
C:\test\20130614\

ファイルについては、削除しません。
C:\test\aa2.log
C:\test\aaa.txt

フォルダの一覧を取得するvbsは作成できました。
ですのであとは、
１．日付形式のフォルダを取得
２．最新の日付形式のフォルダ名を取得する
３．最新以外の日付フォルダを削除する
部分ができれば、できそうです。

サンプルソースや参考サイトを教えてください。

回答No.1

x-1919

日付値としての判断は 「フォルダー名が 8文字であり、なおかつ IsDate で日付値として評価できる」 という条件にした。
DateSerial で日付書式を作成すると 20130631 も 2013年7月1日になってしまうため手動で日付書式を生成した。
これにより 20130631 は "日付値ではない" と判断する。

フォルダーの一覧取得や削除は FileSystemObject を使用した。

日付値どうしの大小比較を行うため、フォルダー名を ADODB Recordset オブジェクトに格納し、Recordset のソート メソッドを使用した。

' 日付形式のフォルダー名を格納する ADODB Recordset
Dim rs
Set rs = CreateObject("ADODB.Recordset")
Call rs.Fields.Append("FolderName", 3) ' フォルダー名 (数値)
Call rs.Fields.Append("FolderSpec", 130, 1000) ' フルパス 文字列 1000文字
Call rs.Open()

' 名前が 8文字で、日付値として評価できるフォルダーを Recoreset に取り込む
Dim fso, f
Set fso = CreateObject("Scripting.FileSystemObject")
For Each f In fso.GetFolder("D:\test").SubFolders
　If Len(f.Name) = 8 Then
　　If IsDate(Left(f.Name, 4) & "/" & Mid(f.Name, 5, 2) & "/" & Mid(f.Name, 7, 2)) Then
　　　Call rs.AddNew()
　　　rs.Fields("FolderName").Value = f.Name
　　　rs.Fields("FolderSpec").Value = f.Path
　　　Call rs.Update()
　　End If
　End If
Next

' 一番大きな日付値が先頭に来るように降順でソートする
rs.Sort = "FolderName DESC"

' 候補フォルダーが 2個以上あれば 2個目以降のフォルダーを削除する
If rs.RecordCount >= 2 Then
　Call rs.Move(1) ' 2個目のレコードに進む
　Do Until rs.EOF
　　fso.DeleteFolder(rs.Fields("FolderSpec").Value)
　　rs.MoveNext
　Loop
End If

Call rs.Close()