はじめに
毎週、週明けに過去1週間分のデータを手作業で削除していた人から自動化を依頼されたときに作成したコードです。
以下のファイルを適当な場所に格納後、タスクスケジューラで以下の引数を指定して起動します。
第一引数:先週一週間のデータを全部消す対象フォルダパス
例)"C:\test"
第二引数:削除対象ファイルの拡張子。すべてのファイルを対象とする場合は「」
例)"*"
Option Explict
' ** 共通メッセージ **
Const I_001 = "ファイルを削除しました。"
Const I_002 = "削除するファイルはありませんでした。"
Const W_001 = "引数が正しく設定されていません。"
Const W_002 = "指定したフォルダが存在しません。"
' ** 共通メッセージ end **
If Wscript.Arguments.Count <> 2 then
Wscript.Echo W_001
Wscript.Quit
End If
Dim delTargetDir
Dim fso, fl, ext
Dim week
Dim today, targetDate, compDate
Dim isDelTargetExist
Set fso = CreateObject("Scripting.FileSystemObject")
delTargetDir = Wscript.Arguments(0)
ext = Wscript.Auguments(1)
today = FormateDateTime(Now, 2)
If not fso.FolderExists(delTargetDir) Then
Wscript.Echo W_002 & "=[" & delTargetDir &"]"
Wscript.Quit
End If
' 曜日区分を取得
week = Weekday(today)
If week = 1 then
' 日曜日の場合
' 今週月曜日の日付を格納
targetDate = DateAdd("d", 1, today)
ElseIf week = 2 then
' 月曜日の場合
' 今日の日付を格納
targetDate = today
Else
' 火曜日以降は今週月曜日の日付を格納
targetDate = DateAdd("d", -(week - 2), today)
End If
isDelTargetExist = False
' フォルダ内のファイル情報を順次取得し、
' 今週月曜より手前のデータを削除
For Each fl in fso.GetFolder(delTargetDir).Files
compDate = FormateDateTime(fso.GetFile(fl.Path).DateLastModified, 2)
If not fl.Name = "Thumbs.db" and _
(ext = "*" or fso.GetExtentionName(fl) = ext) and _
DateDiff("d", compDate, targetDate) >= 1 then
On Error Resume Next
fso.MoveFile fl.Path, "C:\test\"
If Err.Number = 0 Then
isDelTargetExist = True
End If
Err.Clear
End If
Next
' サブフォルダ情報を順次取得し、今週月曜よりも前のデータを削除
For Each fl In fso.GetFolder(delTargetDir).SubFolders
compDate = FormateDateTime(fso.GetFolder(fl.Path).DateLastModified, 2)
If ext = "*" and DateDiff("d", compDate, targetDate) >= 1 Then
On Error Resume Next
fso.MoveFolder fl.Path, "C:\test\"
If Err.Number = 0 Then
isDelTargetExist = True
End If
Err.Clear
End If
Next
If isDelTargetExist Then
Wscript.Echo I_001
Else
Wscript.Echo I_002
End If
Set fso = Nothing