VBAでファイルを消したい

こんばんわ！

VBAでエクセルファイルをバックアップしながら使用しているのですが、１０個以上ファイルが溜まったら一番古いものを消したいです。

途中まではできているのですが、古いファイルを選択する方法が分かりませんToT
途中までのソースを乗せますので、アドバイスの程よろしくお願いいたします。

===＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Private Sub backup_bot_Click()
Dim Path As String, WSH As Variant
Dim fc As Long
Dim fn As String

'マイドキュメントにバックアップ
Set WSH = CreateObject("WScript.Shell")
Path = WSH.SpecialFolders("MyDocuments") & "\test"
If Dir(Path, vbDirectory) = "" Then
MkDir (Path)
End If

'ファイルコピー
FileCopy "c:test_date\aaa.xls", Path & "\aaa" & Format(Now, "yyyymmdd") & ".xls"

'ファイル数確認
fn = Dir(Path & "\aaa*.xls")
Do While fn <> ""
fc = fc + 1
fn = Dir()
Loop
'10件以上消去
If fc > 10 Then
'ここが分かりません！
End If
End Sub
===＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

あ～ちなみにoffice2003エクセルを使用しています。
XP以降のOSで動かしたいです！

No.1 ベストアンサー 回答者： kybo 回答日時： 2012/01/05 05:47

以下の様に一度日付の情報を配列に入れていって、古いもの（数字の小さいもの）から削除すればＯＫかと思います。

Private Sub backup_bot_Click()
Dim Path As String, WSH As Variant
Dim fc As Long
Dim fn As String
Dim AD() As Long
Dim I As Integer
'マイドキュメントにバックアップ
Set WSH = CreateObject("WScript.Shell")
Path = WSH.SpecialFolders("MyDocuments") & "\test"
If Dir(Path, vbDirectory) = "" Then
MkDir (Path)
End If
'ファイルコピー
FileCopy "c:\test_date\aaa.xls", Path & "\aaa" & Format(Now, "yyyymmdd") & ".xls"
'ファイル数確認
fn = Dir(Path & "\aaa*.xls")
Do While fn <> ""
'日付の部分のみ配列に入れる
ReDim Preserve AD(fc) As Long
AD(fc) = Val(Mid(fn, Len("aaa") + 1, 8))
fc = fc + 1
fn = Dir()
Loop
'古いものを11件以上消去
For I = 11 To fc
Kill Path & "\aaa" & WorksheetFunction.Large(AD, I) & ".xls"
Next I
End Sub

この回答へのお礼

なんとか自力で解決できたので、早い対応に感謝しベストアンサーにしておきます＞＜

お礼日時：2012/03/07 22:04

No.2 回答者： jcctaira 回答日時： 2012/01/05 12:13

osarusan0214さん

こんにちは。

EXCEL2003のVBAの機能で「FileSearch」があり、それを使うと便利です。
該当データを全件取得するし、名前順や作成順に並べ替えもします。
※必要ならヘルプを参照してください
今回は作成順（新しい順）に並べ替え、古いファイル11件以上を削除をサブルーチン化してみました。

【使い方】
'ファイル数確認
Call 古いファイル削除(Path , "aaa*.xls")
End Sub　
　
Sub 古いファイル削除(フォルダ As String, ファイル名 As String)
　Dim I　　As Long
　Dim 件数 As Long
　With Application.FileSearch
　　.NewSearch
　　.LookIn = フォルダ
　　.Filename = ファイル名
　　.SearchSubFolders = False
　　件数 = .Execute(msoSortByLastModified, msoSortOrderDescending)
　　If 件数 <= 10 Then Exit Sub
　　For I = 11 To 件数
　　　Kill .FoundFiles(I)
　　Next I
　End With
End Sub

この回答へのお礼

失礼いたしました。
説明不足でした＾＾；
フォルダの中には他にもいくつかファイルが入っております＾＾；
そのため、ファイル全てを並べ替えるご提示いただいたソースだと駄目そうですToT

お礼日時：2012/01/06 12:53