LoginSignup
1
0

More than 5 years have passed since last update.

先週一週間のデータを消すスクリプト

Posted at

はじめに

毎週、週明けに過去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
1
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
1
0