ＰＣ内のフォルダとファイルを強制的に削除する仕組みについて

質問

ＰＣ内のあるフォルダ（例：d:\work)内にあるフォルダとファイルの作成日付が１週間以上経過している場合、強制的に該当のフォルダとファイルを削除する仕組みを作り、毎日定期的にバッチ処理をタスク起動で動かす様にしたいと思います。
何か良い方法はありますか？
宜しくお願い致します。

回答No.2

うぃず（@Wizard_Zero） · ベストアンサー

「フォルダとファイル」でしたね。失礼しました。

補足の仕様にあわせてコードを作り直したのでこちらで試してみてください。なお、Work内のサブフォルダはどんなに階層が深くても削除対象としてあります。つまり「D:\Work\sub\sub\sub\abc.txt」といった深いところでも条件に一致すれば削除します。

※VBSファイルをWork配下に配置すると自身を削除しようとして失敗するので、Workフォルダ以外の場所に保存してください。

[WSH(VBScript)コード]
Set fso = WScript.CreateObject("Scripting.FileSystemObject")

' 指定フォルダから１週間以上前のファイルとフォルダを削除
EnumFolder "D:\Work", DateAdd("d", -7, Now)

' Pathに指定したフォルダからDeleteDate以前のファイル・フォルダを削除
Sub EnumFolder(Path, DeleteDate)

Set folder = fso.GetFolder(Path)

' ファイルを列挙
For Each file In folder.Files

' ファイルの作成日がDeleteDate以前なら削除
If file.DateCreated < DeleteDate Then file.Delete

Next

' サブフォルダを列挙
For Each subfolder In folder.SubFolders

' サブフォルダの中身を削除（再帰処理）
EnumFolder Path & "\" & subfolder.Name, DeleteDate

' フォルダ内のファイルがなくなったらフォルダを削除
If subfolder.Files.Count = 0 Then subfolder.Delete

Next

End Sub

補足

何度も申し訳ございません。
以下の場合も対応できますでしょうか？

d:\work
|---\フォルダ1---\フォルダ2
　　　 |---データなし　　|---データあり（本日作成）

フォルダ１のルートにはデータはありません
フォルダ１には、データがあるサブフォルダ（フォルダ2）があります。
今のスクリプトではフォルダ1、フォルダ2の全てが削除されてしまいます。
サブフォルダ2にあるデータは１週間を経過していないデータなので
この場合何も削除されない・・・と言うものです
可能でしょうか？

回答No.3

うぃず（@Wizard_Zero）

' フォルダ内のファイルがなくなったらフォルダを削除
If subfolder.Files.Count = 0 Then subfolder.Delete

この部分を下記のように修正してください。

' フォルダ内のファイルとフォルダがなくなったらフォルダを削除
If subfolder.Files.Count = 0 And subfolder.SubFolders.Count = 0 Then subfolder.Delete

> 何度も申し訳ございません。

いえいえ、こちらこそミスが多くてすみませんです。。。

お礼

思った通りにできました。
本当にありがとうございました。
助かりました。

回答No.1

うぃず（@Wizard_Zero）

WSHでフォルダ削除のプログラムを組み、タスクでシステム起動時に実行すればよいかと。

WSHのコードは下記を参考にWSHファイル(拡張子.vbs)をDドライブにでも作ってください。（例：D:\Delete.vbs）
タスクに登録する際は、実行ファイル名を
C:\Windows\System32\CScript.exe "D:\Delete.vbs"
とすればWSHを走らせることが出来ます。WSHファイルのパスだけでも動くと思いますが試していません。

[WSH(VBScript)のコード例]
Set fso = WScript.CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder("D:\Work")

' １週間前の日付を算出
dtDelete = DateAdd("d", -7, Now)

' サブフォルダを列挙
For Each subfolder In folder.SubFolders

' 作成日が１週間以上前の場合
If subfolder.DateCreated <= dtDelete Then

' フォルダを削除
subfolder.Delete

End If
Next

お礼

ありがとうございました。
まだ試していませんが・・・
明日にでもやってみます。
本当に、ありがとうございます。

補足

VBScript素人なので良く分からなく、申し訳ございません。
教えて頂いたもので処理してみました。
２点、再度の質問をさせて下さい。

１．D:\workフォルダの直下にあるファイルも削除したいです。
　　但し、workフォルダそのものは削除しません。

２．workフォルダ配下にあるフォルダは削除できましたが
　　１週間を経過していないデータファイルも同時に削除されてしまいます。
　　そこで・・・
　　d:\work配下のデータファイル（サブフォルダも含む）で作成日が１週間
　　以上経過したデータを削除し、その後にフォルダは作成日付ではなく、
　　フォルダ内が空の場合のみ、そのフォルダを削除する。

　　こんな事は可能でしょうか？？？