ファイルを一定期間後に削除する

'*******************************************************************
'　　　監視フォルダ内で保管期限の切れたファイルを削除する
'*******************************************************************
'監視するフォルダと保管日数の定義。フォルダ名と日数の間は/で区切る
Dim chkdir(3) 'As String
chkdir(0) = "c:\temp / 8"
chkdir(1) = "c:\Documents And Settings\use\Local Settings\temp / 1"
chkdir(2) = "i:\exchange / 10"
chkdir(3) = "j:\share / 30"
'ここに追加のフォルダを記入
Dim i, keepday 'As Integer
Dim basedir, tmpstr 'As String
Dim FSO 'As FileSystemObject
Dim now_log, del_log 'As TextStream
Dim tFolder 'As Folder
Set FSO = CreateObject("Scripting.FileSystemObject")
Set now_log = FSO.CreateTextFile(logname(Date)) '本日のログ
On Error Resume Next
'-------------------------------------------------------------------
For i = LBound(chkdir) To UBound(chkdir)
    If chkdir(i) = "" Then Exit For
    basedir = Trim(Left(chkdir(i), InStr(chkdir(i), "/") - 1))
    keepday = CInt(Trim(Mid(chkdir(i), InStr(chkdir(i), "/") + 1)))
    '---------------------------------------------------------------
    '過去のログファイルに記述されているファイルを削除する
    tmpstr = logname(DateAdd("d", -1 * keepday, Date))
    If FSO.FileExists(tmpstr) Then
        Set del_log = FSO.OpenTextFile(tmpstr, 1) '1=readonly
        Do While del_log.AtEndOfStream <> True
            tmpstr = del_log.ReadLine
            If tmpstr = basedir Then '該当フォルダの記述があれば
                tmpstr = del_log.ReadLine
                Do While tmpstr <> "" '空行になるまで続ける
                    If FSO.FileExists(tmpstr) Then _
                        FSO.DeleteFile tmpstr 'ここで削除
                    tmpstr = del_log.ReadLine
                Loop
                Exit Do 'ログファイルの読み込みを終了
            End If
        Loop
        del_log.Close
    End If
    '---------------------------------------------------------------
    '本日のログを取る
    now_log.WriteLine basedir '監視するフォルダ名を記入
    Set tFolder = FSO.GetFolder(basedir)
    write_filename tFolder, now_log
    now_log.WriteLine ("") '記入が終わったら空行を一つ入れる
Next 'i
'-------------------------------------------------------------------
now_log.Close
'*******************************************************************
'以下サブルーチン
'-------------------------------------------------------------------
'日付からログファイル名を作成
Function logname(target_date)
    Dim tmp 'As Integer
    tmp = Year(target_date)
    If tmp > 99 Then tmp = tmp Mod 100
    logname = CStr(tmp)
    If tmp < 10 Then logname = "0" & logname
    tmp = Month(target_date)
    If tmp < 10 Then logname = logname & "0" & CStr(tmp)
    If tmp > 9 Then logname = logname & CStr(tmp)
    tmp = Day(target_date)
    If tmp < 10 Then logname = logname & "0" & CStr(tmp)
    If tmp > 9 Then logname = logname & CStr(tmp)
    logname = logname & ".log"
End Function
'-------------------------------------------------------------------
'ファイル名記入用サブルーチン
Sub write_filename(tFolder, now_log)
    Dim tFile 'As File
    Dim sFolder 'As Folder
    'フォルダ内のファイル名を記入
    For Each tFile In tFolder.Files
        '隠しファイルでなければファイル名を記入
        If hid(tFile) = False Then now_log.WriteLine tFile.Path
    Next
    'フォルダ内のサブフォルダ処理
    For Each sFolder In tFolder.SubFolders
        write_filename sFolder, now_log
    Next
End Sub
'-------------------------------------------------------------------
'隠し属性があればTrueを返す
Function hid(tFile)
    Dim atr 'As Integer
    hid = False
    atr = tFile.Attributes
    If atr > 127 Then atr = atr - 128
    If atr > 63 Then atr = atr - 64
    If atr > 31 Then atr = atr - 32
    If atr > 15 Then atr = atr - 16
    If atr > 7 Then atr = atr - 8
    If atr > 3 Then atr = atr - 4
    If atr > 1 Then hid = True
End Function
'*******************************************************************