[[20160615135114]] 『【マクロ】古いファイルを削除したい』(ダッフィー) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『【マクロ】古いファイルを削除したい』(ダッフィー)

複数あるファイルに格納されている古いファイルを削除したいのですが、
マクロでできますでしょうか。

”あ”のフォルダ
 【yyyymmdd】【あ】xxxxxxx.xlsx
 【yyyymmdd】【い】xxxxxxx.xlsx
 【yyyymmdd】【う】xxxxxxx.xlsx

”い”のフォルダ
 【yyyymmdd】【あ】xxxxxxx.xlsx
 【yyyymmdd】【い】xxxxxxx.xlsx
 【yyyymmdd】【う】xxxxxxx.xlsx

yyyymmdd ← 年月日

例えば今日の日付が2016年6月15日だったら、yyyymmddが2日前の日付のファイルはすべて削除したいです。

以上、よろしくお願いいたします。

< 使用 Excel:Excel2013、使用 OS:Windows7 >


手作業で、エクスプローラで検索してから消すのが安全だと思いますが、まぁ検索ミスもあり得るので、マクロもアリかなぁ?

 Sub test()
    Const cPATH = "C:\test\"
    Dim FSO As Object
    Dim cFiles As Variant
    Dim i As Long

    Set FSO = CreateObject("Scripting.FileSystemObject")

    cFiles = Split(CreateObject("WScript.Shell").Exec("CMD /C DIR /A:-D/B/S """ & cPATH & "*.xls*""").StdOut().ReadAll(), vbNewLine)
    For i = 0 To UBound(cFiles) - 1
        With FSO.GetFile(cFiles(i))
            If 1 < DateDiff("d", .DateLastModified, Now) Then
                Kill cFiles(i)
            End If
        End With
    Next i

    Set FSO = Nothing
 End Sub
(???) 2016/06/15(水) 14:34

 失礼します。

 比較すべき日付はブックの最終更新日なのでしょうか?
 それとも ブック名が すべて  【yyyymmdd】【あ】xxxxxxx.xlsx という基準で統一されていて
 ブック名の最初の【yyyymmdd】のyyyymmdd を比較するのでしょうか?

(β) 2016/06/15(水) 16:11


Sub main()
    Dim Shell, myPath, dt As String
    Set Shell = CreateObject("Shell.Application")
    Set myPath = Shell.BrowseForFolder(&O0, "古いファイルが格納されたフォルダを選んでください。", &H1 + &H10, "Y:")
    If Not myPath Is Nothing Then
        Dim FSO As Object, fl As Object
        Set FSO = CreateObject("Scripting.FileSystemObject")
            For Each fl In FSO.GetFolder(myPath.Items.Item.Path).Files
                If Left(fl.Name, 10) Like "【*】" Then
                    dt = Mid(fl.Name, 2, 8)
                    If DateSerial(Left(dt, 4), Mid(dt, 5, 2), Right(dt, 2)) <= Date - 2 Then Kill myPath.Items.Item.Path & "\" & fl.Name
                End If
            Next fl
        Set FSO = Nothing
        Else
        MsgBox "処理がキャンセルされました。": Exit Sub
    End If
    Set Shell = Nothing
    Set myPath = Nothing
End Sub
(mm) 2016/06/15(水) 16:49

今日ですと、イメージは
C:\test\あ\【20160614】【あ】xxxxxxx.xlsx
C:\test\あ\【20160614】【い】xxxxxxx.xlsx
C:\test\あ\【20160614】【う】xxxxxxx.xlsx

C:\test\い\【20160614】【あ】xxxxxxx.xlsx
C:\test\い\【20160614】【い】xxxxxxx.xlsx
C:\test\い\【20160614】【う】xxxxxxx.xlsx

それぞれのフォルダにデイリーで
【yyyymmdd】←前日の日付のものが3種類格納されます。

蓄積されていくので、yyyymmdd が2日前以前のものを削除したいのです。

宜しくお願い致します。
(ダッフィー) 2016/06/15(水) 17:26


ファイルの更新日付はどうでも良くて、ファイル名の中に書かれた日付で比較する訳ですね。
mmさんのコードでは駄目だったのでしょうか? 一応、ファイル名対応に変えた版なぞ。

 Sub test()
    Const cPATH = "C:\test\"
    Dim cFiles As Variant
    Dim cw1 As String
    Dim cw2 As String
    Dim i As Long

    cw1 = Format(Now - 1, "YYYYMMDD")

    cFiles = Split(CreateObject("WScript.Shell").Exec("CMD /C DIR /A:-D/B/S """ & cPATH & "【????????】*.xls*""").StdOut().ReadAll(), vbNewLine)
    For i = 0 To UBound(cFiles) - 1
        cw2 = Mid(cFiles(i), InStrRev(cFiles(i), "\【") + 2, 8)
        If cw2 < cw1 Then
            Kill cFiles(i)
        End If
    Next i
 End Sub
(???) 2016/06/15(水) 17:52

皆様、ご教示いただきありがとうございました。
(ダッフィー) 2016/06/17(金) 10:07

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.