"Diary" インターネットさんへの恩返し

いつもソースコードコピペばかりなので,みなさまへ少しばかりの恩返しを

【VBS】複数ディレクトリ、X日以上前のファイル削除



スポンサーリンク


複数のディレクトリを指定し、かつタイムスタンプが特定日数以上経過しているファイルを削除するVBScript。指定ディレクトリを再起にできれば、更によいですがディレクトリ個別指定のほうが安全と思い個別指定にしました。

Option Explicit

'指定期間(日)経過ファイルを削除
Dim OldDays
OldDays = 60

'指定ディレクトリ毎にファイル削除を行います。
Dim aryFolder(3)
aryFolder(0) = "D:\Dir0"
aryFolder(1) = "D:\Dir1"
aryFolder(2) = "D:\Dir2"
aryFolder(3) = "D:\Dir3"

'////////////////////////////////////////////////////////
'メイン処理開始
'////////////////////////////////////////////////////////

'指定フォルダ内を一つづつ処理
Dim folder
For Each folder in aryFolder
	deleteFiles(folder)
Next

'////////////////////////////////////////////////////////
'ファイルリストアップ・削除関数
'////////////////////////////////////////////////////////
Sub deleteFiles(folder)

	On Error Resume Next
	Dim fileinfo(1)
	Dim i
	Dim targetFolder,file
	Dim fso
	Set fso = WScript.CreateObject("Scripting.FileSystemObject")
 	Set targetFolder = fso.GetFolder(folder)

	i = 0

	Wscript.echo targetFolder
	For Each file In targetFolder.Files
		'------------ タイムスタンプでフィルタ--------------
		if DateDiff("d", file.DateLastModified, date) >= OldDays then
			fileinfo(0) = file.Name            'ファイル名
			fileinfo(1) =file.DateLastModified '変更日
			fso.DeleteFile targetFolder &"\"& fileinfo(0) '削除

			if not Err.Number = 0 then
				Wscript.echo " " & fileinfo(0) & " "& fileinfo(1) &" を削除できませんでした。 err " & Err.Number
				Wscript.Quit(1)
			else
				Wscript.echo " " & fileinfo(0) & " "& fileinfo(1) &" を削除しました。"
			end if
		    i = i + 1
		end if
	Next