VBA Macro to delete files with date on name

Nelsini

New Member
Joined
May 13, 2021
Messages
7
Office Version
  1. 2019
Platform
  1. Windows
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.
 

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.

offthelip

Well-known Member
Joined
Dec 23, 2017
Messages
1,908
Office Version
  1. 2010
Platform
  1. Windows
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
VBA Code:
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
 
Solution

Nelsini

New Member
Joined
May 13, 2021
Messages
7
Office Version
  1. 2019
Platform
  1. Windows
@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

New Member
Joined
May 13, 2021
Messages
7
Office Version
  1. 2019
Platform
  1. Windows
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:


VBA Code:
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

New Member
Joined
May 13, 2021
Messages
7
Office Version
  1. 2019
Platform
  1. Windows
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!
 

Forum statistics

Threads
1,137,062
Messages
5,679,392
Members
419,825
Latest member
MegastarMagus

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top