【VBS】更新日が指定日数以上経過したファイルを再帰的に削除する - 変換.tokyo | henkan.tokyo

【VBS】更新日が指定日数以上経過したファイルを再帰的に削除する


■【VBS】更新日が指定日数以上経過したファイルを再帰的に削除する

更新日が指定日数以上経過したファイルを再帰的に削除するVBScriptです。

下記のWebサイト「jfmillet40」を参考に、フォルダ指定方法をアレンジしました。
https://sites.google.com/site/jfmillet40/home/vbscript/memo

更に「DaysOfDeletion」の値をInputboxを使って入力させるようにすれば、汎用性のあるツールになります。


■サンプルコード

Option Explicit

'更新日が何日以上前のファイルを削除するか?
Const DaysOfDeletion = 90

'削除処理をする対象フォルダ
Dim TargetFolderPath

'-----------------------------------
' オブジェクト定義
'-----------------------------------

Dim fso
Dim subf

Dim FileName ' ファイル名
Dim FolderName ' フォルダ名
Dim FDate ' ファイルの更新日

'-----------------------------------
' メイン処理
'-----------------------------------

Dim StartMsg
Dim EndMsg

'フォルダのパスを取得
TargetFolderPath = InputBox("削除対象ファイルの保存先フォルダを指定してください。","【90日経過したファイルを一括削除】保存先フォルダは?")

Set fso = CreateObject("Scripting.FileSystemObject")
Set subf = fso.GetFolder(TargetFolderPath)

If Len(TargetFolderPath) = 0 Then
WScript.Quit
Else
Call FileDel(subf)
End If

EndMsg = MsgBox("「" & TargetFolderPath & "」フォルダ内の" & DaysOfDeletion & "日以上前のファイルを削除しました。",vbOKOnly ,"古いファイルの削除")

'-----------------------------------
' 指定フォルダ直下のファイル削除処理
'-----------------------------------

Dim SubFolder1

Sub FileDel(SubFolder1)

For Each FileName In SubFolder1.Files 'フォルダ内のファイル名を取得

' ファイルの更新日を取得
fdate = FileName.DateLastModified

' 更新日から削除するか否かを判定
if DateDiff("d", fdate, date) >= DaysOfDeletion then
' ファイル削除
fso.DeleteFile FileName
end if

Next

'サブフォルダがある際の処理
Call FolderCheck(SubFolder1)

End Sub

'-----------------------------------
' サブフォルダがある際の処理
'-----------------------------------

Dim SubFolder2

Sub FolderCheck(SubFolder2)

For Each FolderName In SubFolder2.Subfolders 'サブフォルダ名を取得

'サブフォルダ内のファイル削除処理
Call FileDel(FolderName)

Next

End Sub

'-----------------------------------
' オブジェクト開放
'-----------------------------------

set fso = Nothing


■サンプルVBSダウンロード
こちらから


■VBSを作成するのに参考となる書籍
[商品価格に関しましては、リンクが作成された時点と現時点で情報が変更されている場合がございます。]

VBScriptポケットリファレンス改訂版 (Pocket reference) [ アンク ]
価格:2030円(税込、送料無料) (2018/9/15時点)

楽天で購入


by カエレバ
by カエレバ
by カエレバ
by カエレバ
by カエレバ
by カエレバ