投稿時間:2004/12/15(Wed) 09:22 投稿者名:kazuやん
Eメール:
URL :
タイトル:関数作成のヒント?
> > 引数に指定した日付以前のファイルが一括削除できるようなメソッドってありますか? > > ありません。 > 必要なら関数を作成して下さい。
関数を作る場合のヒントを簡単に提示 1.ファイルの拡張子は? さすがに指定日付以前のファイルを全部消すといっても拡張子を指定しないと危険では? ないとは思いますが間違ってWindowsファイルを削除してしまうかもしれませんし 2.ファイルパスを指定 これは引数でも良いですし、iniファイルに指定して読み込むでもありだと思います。 ちなみにiniファイルから値を取得するならAPIのGetPrivateProfileStringを使うのが普通かな? 3.指定されたパスのファイル一覧取得 以下がその関数です。参考にして下さい。
'-------------------------------------------------------------------------------- '================================================================================ ' ファイル検索 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 '--------------------------------------------------------------------------------
4.日付以前のファイルを削除 3で取得したファイルの更新日を取得 例) 'ファイルシステムオブジェクト作成 Set myFSO = CreateObject("Scripting.FileSystemObject") Set myFile = myFSO.GetFile("test.xls") myFile.DateLastModified ← ファイルの更新日 この日付を指定した日付とDateDiff関数で比べて古かったらKillコマンドで削除
少しでも参考になればと思います。
|