VBA Macro to delete files with date on name

[Nelsini]

Hello,

I have a folder (let's say E:\Test ) that contains files created daily that have the name yyyy-mm-dd_test.xlsx
I have another excel on a different folder that gathers the info on the files from E:\Test, putting it into tables.
The problem is, I need to delete the files in E:\Test that are older than 30 days, but I need to do it based of the name of the file, not the creation/modification date. I have no ideia how to do this and I've circled around a couple of threads but haven't found a working solution for me yet.

Thank you in advance for the help.

 

[offthelip]

Try this code, you need to save the workbook with the code in into the folder E:\Test because it uses the path of the active workbook as the starting point. it then create a folder called "TOBEDELETED" just below this folder, it then runs through all the files in the folder works out hte date from the name a deletes those that are older than the number specifed ( set at 10 at the moment for testing).
If the TOBEDELETED folder already exists the code will stop with an error.
YOU MUST add a reference to Microsoft Scripting runtime in the VBA references, otherwise you wil get an undefined error

Sub tst()
' you must add a reference to "Microsoft scripting runtime" in the VBA references
    Dim FSO As New FileSystemObject
    Dim myFolder As Folder
    Dim myFile As File
tday = Date
spath = ActiveWorkbook.Path
FSO.CreateFolder spath & "\TOBEDELETED"
 
 
  Set myFolder = FSO.GetFolder(spath)
              For Each myFile In myFolder.Files
 '              Cells(i, 1) = mySubFolder.Name
               nm = myFile.Name
              yr = Left(nm, 4)
              mn = Mid(nm, 6, 2)
              dd = Mid(nm, 9, 2)
              If IsNumeric(yr) And IsNumeric(mn) And IsNumeric(dd) Then
                rdate = DateSerial(yr, mn, dd)
                Delta = tday - rdate
                If Delta > 10 Then  ' change the value here to however many days you wnat to keep
                   src = myFile.Path
                   dst = spath & "\TOBEDELETED\" & nm
                   Name src As dst
                End If
              End If
              Next myFile
     
End Sub

Fairly obviously to actually delete the files just delete the folder TOBEDELETED, but the code does give you a chance to check it is Ok to be deleted

 

[Nelsini]

@offthelip worked like a charm! going to add a msgbox to list the files before confirming the deletion, but this is exactly what I wanted, cheers!!

 

[Nelsini]

spath = ActiveWorkbook.Path
FSO.CreateFolder spath & "\TOBEDELETED"

Is there any way to change this to a sub folder in the ActiveWorkbook.Path? I've tried a couple of things but can't get it to accept the same code but in a subfolder.
Ex:
I have the excel in the folder E:\Test and the files I want to delete are in the folder E:\Test\test2. Any way to do that?

I also went around the error if the folder exists with an if statement so we're good on that end, here is my code at the moment with a few changes to it:

Sub FileDeletion()
' you must add a reference to "Microsoft scripting runtime" in the VBA references
    Dim FSO As New FileSystemObject
    Dim myFolder As Folder
    Dim myFile As File
tday = Date
spath = ActiveWorkbook.Path
FSO.CreateFolder spath & "\TOBEDELETED"
 
 
  Set myFolder = FSO.GetFolder(spath)
              For Each myFile In myFolder.Files
 '              Cells(i, 1) = mySubFolder.Name
               nm = myFile.Name
              yr = Left(nm, 4)
              mn = Mid(nm, 6, 2)
              dd = Mid(nm, 9, 2)
              If IsNumeric(yr) And IsNumeric(mn) And IsNumeric(dd) Then
                rdate = DateSerial(yr, mn, dd)
                Delta = tday - rdate
                If Delta > 30 Then  ' change the value here to however many days you wnat to keep
                   src = myFile.Path
                   dst = spath & "\TOBEDELETED\" & nm
                   Name src As dst
                End If
              End If
              Next myFile
    

'confirmation message box listing the files in the TOBEDELETED


Dim StrFile As String, StrFiles As String
StrFile = Dir(spath & "\TOBEDELETED" & Range("M" & ActiveCell.Row).Value & "\" & Range("Z" & ActiveCell.Row).Value & "\*.*")


Do While StrFile <> ""
    If StrFile <> "log.txt" Then StrFiles = StrFiles & vbCrLf & StrFile
    StrFile = Dir
Loop


ConfirmDelete = MsgBox(StrFiles, vbYesNo, "Continue?")


If ConfirmDelete = vbYes Then


    Set FSO = CreateObject("Scripting.FileSystemObject")
    FSO.deletefolder spath & "\TOBEDELETED", False
Else
    FSO.MoveFile spath & "\TOBEDELETED\*.*", spath
    FSO.deletefolder spath & "\TOBEDELETED"
End If
    
End Sub

 

[Nelsini]

Lol I got it, it was just adding the following on the spath string

spath = ActiveWorkbook.Path & "\" & "test2"

God, I don't get coding XD
Thank you for the help!