投稿日	： 2004/12/15(Wed) 09:22
投稿者	： kazuやん
Ｅメール	：
ＵＲＬ	：
タイトル	： 関数作成のヒント？

> > 引数に指定した日付以前のファイルが一括削除できるようなメソッドってありますか？
> > ありません。
> 必要なら関数を作成して下さい。

関数を作る場合のヒントを簡単に提示
１．ファイルの拡張子は？
　さすがに指定日付以前のファイルを全部消すといっても拡張子を指定しないと危険では？
　ないとは思いますが間違ってWindowsファイルを削除してしまうかもしれませんし
２．ファイルパスを指定
　これは引数でも良いですし、iniファイルに指定して読み込むでもありだと思います。
　ちなみにiniファイルから値を取得するならAPIのGetPrivateProfileStringを使うのが普通かな？
３．指定されたパスのファイル一覧取得
以下がその関数です。参考にして下さい。

'--------------------------------------------------------------------------------
'================================================================================
' ファイル検索  FindFile()
' [IN]  FindPath        ファイルを検索するパス
'       FindFilename    ファイル拡張子
'       SearchSubFolder サブフォルダを検索するか否か
' [OUT] FindFile        lstTargetがNothingの場合：vbCrlfで区切った見つかった
'                       ファイルのリスト。
'                       上記以外の場合：長さ0の文字列
'================================================================================
Public Function FindFile(ByVal FindPath$, ByVal FindFilename$, ByVal SearchSubFolder As Boolean) As String
    Dim wfdDir As WIN32_FIND_DATA
    Dim hFindDir As Long
    Dim newName$, newPath$
    Dim SubRet$
    Dim w_str1 As String       'パスの拡張子
    Dim w_str2 As String       '検索ヒットしたファイルの拡張子

    FindPath = Root(FindPath)

    ' ファイル検索開始（隠しファイル、システムファイルも検索）
    ' FindFilenameにマッチするファイルをFindPathから探す
    
    '拡張子制御
    If InStr(FindFilename, "*.") = 0 Then
        FindFilename = "*." & FindFilename
    End If
    
    newName = Dir(FindPath & FindFilename)

    Do While newName <> ""
            w_str1 = Mid(FindFilename, InStr(FindFilename, "."), (Len(FindFilename) - InStr(FindFilename, ".") + 1))
        w_str2 = Mid(newName, InStr(newName, w_str1), (Len(newName) - InStr(newName, w_str1) + 1))
        
        '拡張子が一致する物のみ
        If StrComp(w_str1, w_str2) = 0 Then
            ' 戻り値
            Ret = Ret & FindPath & newName & vbCrLf
        End If

        ' 次を検索
        newName = Dir()
    Loop

    ' サブフォルダを検索
    If SearchSubFolder Then
    
        ' すべてのファイル・フォルダをFindPathから探す
        hFindDir = FindFirstFile(FindPath & "*", wfdDir)
        If hFindDir <> 0 Then
            Do
                ' フォルダ（ディレクトリ）を発見した場合
                If (wfdDir.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY Then
                    
                    ' ファイル名の取得
                    newPath = wfdDir.cFileName
                    newPath = Left(newPath, InStr(1, newPath, Chr(0)) - 1)
                    
                    If newPath <> "." And newPath <> ".." Then
                        ' 再帰処理 − 自分自身を呼び出す。
                        ' 見つけたフォルダ内からFindFilenameにマッチするファイルを探す
                        SubRet = SubRet & FindFile(FindPath & newPath, FindFilename, True)
                    End If
                End If
            ' 次を検索
            Loop While FindNextFile(hFindDir, wfdDir)
        End If
        '検索終了
        Call FindClose(hFindDir)
        
    End If
    FindFile = Ret
End Function
'--------------------------------------------------------------------------------

４．日付以前のファイルを削除
３で取得したファイルの更新日を取得
例）
    'ファイルシステムオブジェクト作成
    Set myFSO = CreateObject("Scripting.FileSystemObject")
    Set myFile = myFSO.GetFile("test.xls")
    myFile.DateLastModified ← ファイルの更新日
　　この日付を指定した日付とDateDiff関数で比べて古かったらKillコマンドで削除

少しでも参考になればと思います。

★ - 指定日付以前のファイル一括削除 - うさぎ 12/14-22:53No.1250
• Re: 指定日付以前のファイル一括削除 - 花ちゃん 12/14-23:14 No.1251
  • 関数作成のヒント？ - kazuやん 12/15-09:22 No.1256