フォルダー内の古いファイルを削除

• 指定のフォルダー内の、古いファイルをまとめて削除します。
  経過日数を指定して、それ以上経過した古いファイルに関しては全て削除いたします。
  毎回、手作業でファイル削除をされている方には便利なツールになります。
  (注意)削除後に復元できませんので自己責任でご使用ください
  
  
  無料ダウンロード

• ※Microsoft Excelを使用します。

• フォルダー内の古いファイルを削除

• 使用VBAコード----------

Sub 古いファイルを削除する()
' 変数を宣言
Dim basePath As String, extension As String
Dim fileName As String
Dim fileDate As Date
Dim diffDay As Integer
Dim specifiedDays As Variant ' 空白を許容するためにVariant型を使用
Dim ws As Worksheet

' ワークシートを設定
Set ws = ThisWorkbook.Sheets("Sheet1") ' "Sheet1"を実際のシート名に変更してください

' セルから値を取得
specifiedDays = ws.Range("C5").Value ' Excelシートからの指定日数
basePath = ws.Range("C11").Value ' Excelシートからのフォルダパス
extension = "xdw" ' ファイルの拡張子を設定

' 指定日数が入力されているか確認
If IsEmpty(specifiedDays) Then
MsgBox "セルC5に指定日数を入力してください。", vbExclamation
Exit Sub
End If

' basePathが空でないことを確認
If basePath <> "" Then
' 指定した拡張子を持つディレクトリ内の最初のファイルを取得
fileName = Dir(basePath & "\*" & extension, vbNormal)

' ディレクトリ内のすべてのファイルをループ
Do Until fileName = ""
' ファイルの最終変更日を取得
fileDate = FileDateTime(basePath & "\" & fileName)

' 最終変更日から現在日までの日数の差を計算
diffDay = DateDiff("d", fileDate, Now())

' 差が指定された日数より大きい場合、ファイルを削除
If diffDay > specifiedDays Then
Kill basePath & "\" & fileName
End If

' ディレクトリ内の次のファイルを取得
fileName = Dir()
Loop
Else
MsgBox "セルC11に有効なフォルダパスを指定してください。", vbExclamation
End If
End Sub