using VBA, how do I delete every other file in a specified folder?

I have several folders with hundreds of auto-generated backups going back a couple of years. I want to thin out the herd and I'm hoping that there's a macro that will let me do just that, keeping files distributed evenly going back to the oldest backup. It would also be nice to have the macro customizable so that I could delete two files out of every three, or three out of every going backward.

Does this make sense?

John CarneyReliability Business Tools Analyst IIAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Rory ArchibaldCommented:
I think this should do it:

Sub DeleteThem()
    FileDeleter "C:\Testing2", 2, 4 ' deletes 2 out of every 4
End Sub
Sub FileDeleter(sPath As String, lNum As Long, lDenom As Long)
    Dim asFiles()             As String
    Dim sFile                 As String
    Dim lCounter              As Long
    Dim n                     As Long

    If VBA.Right$(sPath, 1) <> "\" Then sPath = sPath & "\"

    ReDim asFiles(1 To 1000)
    lCounter = 1

    sFile = Dir(sPath & "*.*")

    If sFile <> vbNullString Then
            If lCounter = UBound(asFiles) - 1 Then ReDim Preserve asFiles(1 To UBound(asFiles) + 1000)
            asFiles(lCounter) = sFile
            lCounter = lCounter + 1
            sFile = Dir
        Loop While sFile <> vbNullString

        ReDim Preserve asFiles(1 To lCounter - 1)

        For n = LBound(asFiles) To UBound(asFiles)
            If (n - 1) Mod lDenom < lNum Then Kill sPath & asFiles(n)
        Next n
    End If

End Sub

Open in new window

Note this goes through the files in alphabetical order.

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
To get an even distribution, I would first shuffle the file names and then delete the files at the top of the 'deck'.  Be sure to set the cPath literal to your path, retaining the trailing back slash character.
Sub Q_28629442(parmDeleteRatio)
    Dim colFilenames As New Collection
    Dim colShufflednames As New Collection
    Dim strFilename As String
    Dim lngLoop As Long, lngItem As Long
    Dim strRnd As String
    Dim vItem As Variant
    Const cPath As String = "C:\Users\Aikimark\Downloads\Q_28629442\"
    If 0 <= parmDeleteRatio And parmDeleteRatio <= 1 Then
        MsgBox "Invalid parmDeleteRatio"
        Exit Sub
    End If
    strFilename = Dir(cPath & "*.*")
    Do Until Len(strFilename) = 0
        colFilenames.Add strFilename
        strFilename = Dir()
'    For Each vItem In colFilenames
'        Debug.Print vItem
'    Next
'        strFilename = Replace(Mid(CreateObject("scriptlet.typelib").GUID, 2, 36), "-", vbNullString)
'        Debug.Print strFilename
        strRnd = strRnd & strFilename   ' Replace(Mid(CreateObject("scriptlet.typelib").GUID, 2, 36), "-", vbNullString)
    Loop Until Len(strRnd) >= (colFilenames.Count * 2)
    For lngLoop = 1 To Len(strRnd) Step 2
        lngItem = CLng("&h" & Mid(strRnd, lngLoop, 2))
        lngItem = Int((lngItem / 256) * colFilenames.Count) + 1
'        Debug.Print lngItem, ;
        colShufflednames.Add colFilenames(lngItem)
        colFilenames.Remove lngItem
        If colFilenames.Count = 0 Then Exit For
'    Debug.Print
'    For Each vItem In colShufflednames
'        Debug.Print vItem
'    Next
    For lngLoop = 1 To (parmDeleteRatio * colShufflednames.Count)
        Debug.Print "Killing: ", cPath & colShufflednames(lngLoop)
        'Kill cPath & colShufflednames(lngLoop)
End Sub

Open in new window

In this example, I'm deleting a (random) quarter of the files

Open in new window

Note: After testing, uncomment the Kill statement.
Danny ChildIT ManagerCommented:
If you do a search on the top folder for *.* it should return all the files from all the subfolders.

You could then just sort by date, and then delete by pressing Del --> Enter (to confirm the deletion, --> then Down arrow to skip a file.  Repeat until fingers fall off.

Tedious, but unless you have tens of 1000s of files, or they generate every day, it'd be quicker.
Learn Ruby Fundamentals

This course will introduce you to Ruby, as well as teach you about classes, methods, variables, data structures, loops, enumerable methods, and finishing touches.

John CarneyReliability Business Tools Analyst IIAuthor Commented:
Unlocking the mysteries of the Universe, one macro at a time!  Thanks, Rory, it worked flawlessly.

~ John
Did you evaluate or test my code?
John CarneyReliability Business Tools Analyst IIAuthor Commented:
Hi Aikimark, I did test it and it hung and I had to force restart Excel, so then I tried Rory's code which worked. I realize now that I failed to uncomment the kill statement in your code. I will test it again, but if it works I don't know how I could change the points assignment.
John CarneyReliability Business Tools Analyst IIAuthor Commented:
Oh I forgot: it wouldn't run at all as written. So I deleted "parmDeleteRatio" in the first line of the Sub just to see if it would run; and then it did run but it hung.
1. you must have parmDeleteRatio in the routine definition or else define and assign a value to it in the routine itself.  Otherwise, how is the routine supposed to know what percent of the files to delete?!?

2. You can invoke the routine from the Immediate window (Ctrl+G) or other code.  I included  an example of the invoking statement in my earlier comment.

3. Even before you uncomment the Kill statement, the proposed actions are printed in the Immediate window.

4. I'm not sure what could be the cause of an Excel 'hang'.  Did it 'hang' after you removed the parameter?

5. Make sure you have an Option Explicit in the general declarations section of the code.  If you have done something that causes the code to not compile, this should catch it.

If you have working code, there is no need to open the question for points reassignment.  However, if my solution is better and is the one you will use, then we can open the question for you.
John CarneyReliability Business Tools Analyst IIAuthor Commented:
I could see that removing the "parmDeleteRatio" would invalidate the code but since I couldn't invoke the routine via button, F5,  calling from another macro, or stepping through it, I was dead in the water. Are you able to step through it? BTW, how exactly would I call this particular macro in the Immediate window?
as I showed in my earlier comment
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.