Link to home
Start Free TrialLog in
Avatar of John Carney
John CarneyFlag for United States of America

asked on

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?

Thanks,
John
ASKER CERTIFIED SOLUTION
Avatar of Rory Archibald
Rory Archibald
Flag of United Kingdom of Great Britain and Northern Ireland image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start 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
    Else
        MsgBox "Invalid parmDeleteRatio"
        Exit Sub
    End If
    strFilename = Dir(cPath & "*.*")
    Do Until Len(strFilename) = 0
        colFilenames.Add strFilename
        strFilename = Dir()
    Loop
'    For Each vItem In colFilenames
'        Debug.Print vItem
'    Next
    Do
'        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
        
    Next
'    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)
    Next
End Sub

Open in new window

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

Open in new window

Note: After testing, uncomment the Kill statement.
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.
Avatar of John Carney

ASKER

Unlocking the mysteries of the Universe, one macro at a time!  Thanks, Rory, it worked flawlessly.

~ John
Did you evaluate or test my code?
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.
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.
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