VBS/作成日付が古いファイルを削除する

指定されたフォルダ以下にある、フォルダやファイルの作成日を見て、規定の日付より古いモノを削除するVBSスクリプトをご紹介します。

目次

VBSのソースコード

以下のようになります。
ファイルは本記事ページ下部の「添付」-「oldfile_delete.vbs」からダウンロードできます。

'-----------------------------------
' オブジェクト定義
'-----------------------------------
dim arg
dim fso
dim subf
'
dim FileName   ' ファイル名
dim FolderName ' フォルダ名
dim ArgDam     ' 遡り日数
dim OldDate    ' 遡り日
dim FDate      ' ファイルないしフォルダの作成日

Set arg = WScript.Arguments
Set fso = CreateObject("Scripting.FileSystemObject")


'-----------------------------------
' 引数の取得
'-----------------------------------
if arg.Count < 2 then
    ' 引数2が取得できない場合は7をセット
    ArgDam = 7
else
    ArgDam = arg(1)
end if

' 引数に指定されたフォルダの情報を取得
Set subf = fso.GetFolder(arg(0))


'-----------------------------------
' 直下の各ファイル確認処理
'-----------------------------------
For Each FileName In subf.Files

    ' ファイル名の取得
    fdate = FileName.DateCreated

    ' 温存と削除判定
    if DateDiff("d", fdate, date) >= argdam then
        ' ファイル削除
        fso.DeleteFile FileName
    end if
Next


'-----------------------------------
' 直下の各フォルダ確認処理
'-----------------------------------
For Each FolderName In subf.Subfolders

    ' フォルダ名の取得
    fdate = FolderName.DateCreated

    ' 温存と削除判定
    if DateDiff("d", fdate, date) >= argdam then
        ' フォルダ削除
        fso.DeleteFolder FolderName
    end if
Next


'-----------------------------------
' オブジェクト開放
'-----------------------------------
set fso = Nothing

引数１はフォルダ名、引数２は遡り日になります。
引数２は省略が可能で、省略した場合は７がセットされます。
バッチを動かした日から７日経過していれば、
そのファイルやフォルダは削除対象ということです。

参考にして作成した関数

'***** 古いファイルの削除・開始 *****
'引数：拡張子、ディレクトリ名、遡り日数
Sub OldFileDelete(strExt, strFolder, numDays)

	Dim objFSO
	Dim MyFolder
	Dim MyFileName   		'ファイル名
	Dim MyFileDayOfMake     'ファイルないしフォルダの作成日
	Dim MyExt				'拡張子

	Set objFSO = CreateObject("Scripting.FileSystemObject")

	' 引数に指定されたフォルダの情報を取得
	Set MyFolder = objFSO.GetFolder(strFolder)

	For Each MyFileName In MyFolder.Files

	    ' ファイル名の取得
	    MyFileDayOfMake = MyFileName.DateCreated

		' 拡張子の取得
		MyExt = fso.GetExtensionName(strFolder & "\" & MyFileName)

	    ' 温存と削除判定
	    If DateDiff("d", MyFileDayOfMake, date) >= numDays 
	    		And	MyExt = strExt Then
	        ' ファイル削除
	        fso.DeleteFile MyFileName
	    end if
	Next

	Set objFSO = Nothing

End Sub
'***** 古いファイルの削除・終了 *****

• 参考サイト
  http://www.rocket-web.net/blog/staff/2009/05/vbs-1.html