Excel2000 VBA Firefoxダウンロードフォルダ内のファイルを削除する 実験

Excel2000 VBA  Firefoxダウンロードフォルダ内のファイルを削除する　実験

マイドキュメント￥ダウンロード　フォルダ内のファイルを一括削除する（復元できないので必要なファイルは事前に移動する）

７日以上前にダウンロードしたファイルをファイル名を確認しながら削除、キャンセル

Sub FirefoxDLファイル削除()
'Firefoxダウンロード時の保存フォルダ内のファイルを削除
'削除すると、復元できないので注意が必要
'ファイルを一括削除
'７日以上前のファイルを確認しながら削除する
'
Dim buf, file_name, file_date, MB As String
Dim cnt As Long
Const Path As String = "d:\bk\ダウンロード\"
    buf = dir(Path & "*.*")
'一括削除、削除確認、キャンセル
    MB = MsgBox("一括削除するには「はい」を" & vbCrLf + vbCrLf & "確認しながら削除するには「いいえ」を" & vbCrLf + vbCrLf & "キャンセルするには「キャンセル」を押して下さい。", vbYesNoCancel)
Select Case MB
    Case vbYes
        GoTo all_kill
    Case vbNo
        GoTo v_kill
    Case vbCancel
        Exit Sub
End Select

'７日前のダウンロードファイル名を確認しながら削除
v_kill:
    Do While buf <> ""
        file_name = buf
        file_date = FileDateTime(Path & buf)
       
    'ファイルが７日以上前なら削除
            If DateDiff("d", file_date, Now) > 7 Then
            MB = MsgBox(file_name & "  " & file_date & " 削除しますか？", vbYesNo)
      
            Select Case MB
                Case vbYes
                    Kill Path & file_name
                Case vbNo
             
            End Select
            End If
        buf = dir()
    Loop
    MsgBox "該当する削除対象ファイルが有りません。" & vbCrLf & "終了します。"
    Exit Sub
   
all_kill:
    Do While buf <> ""
        file_name = buf
        Kill Path & file_name
        buf = dir()
        cnt = cnt + 1
    Loop
    MsgBox cnt & "個　削除しました。" & vbCrLf & "終了します。"


End Sub

 

---

ブックを作成して、ファイル一覧をシートに表示

 

Sub firefox_DL_filename()
'
'DLファイル名と日時一覧
'
Dim buf, file_name, file_date, MB As String
Dim cnt, i, file_size As Long
Const Path As String = "d:\bk\ダウンロード\"
    buf = dir(Path & "*.*")
'newBOOK作成
    Workbooks.Add
    Worksheets("sheet1").Select

 Do While buf <> ""
        cnt = cnt + 1
        file_name = buf
        file_date = FileDateTime(Path & buf)
        file_size = FileLen(Path & buf)
        Cells(cnt + 1, "A") = file_name
        Cells(cnt + 1, "B") = Int(file_size / 1024) & "KB"
        Cells(cnt + 1, "C") = file_date
        buf = dir()
 Loop
'項目名設定
    Range("A1") = "ファイル名    ファイル数: " & cnt
    Range("B1") = "ファイルサイズ（KB）"
    Range("C1") = "日時"
'セル幅を整える
    Columns("A").Select
    Selection.ColumnWidth = 56
    Columns("B").Select
    Selection.ColumnWidth = 16
    Columns("C").Select
    Selection.ColumnWidth = 16
Range("A").Select

End Sub

 

 

タグ：Excel2000 VBA