Deleting files in a network drive using a list in Excel

[eric5605]

Hello,
I have a large shared network drive that I exported the file names and folder path into Excel. I identified about 10,000 files as duplicates needing deletion and marked them as such in the spreadsheet. Is there a way I can automate deleting the files I marked "delete" in Excel from the shared network drive or do I need to find each in Windows Explorer and delete manually? Here is an image of the spreadsheet. I am an intermediate Excel user so I'm not sure how to use VBA or macros to accomplish this task... if possible. Thank you!

 

[johnnyL]

How about something like:

Sub DeleteFiles()
'
    Dim ArrayRow        As Long
    Dim LastRowColumnA  As Long
    Dim FileToDelete    As String
    Dim InputArray      As Variant
'
    LastRowColumnA = Range("A" & Rows.Count).End(xlUp).Row                      ' Find last row used in Column A
'
    InputArray = Range("A1:H" & LastRowColumnA)                                 ' Load all data from sheet into InputArray
'
    For ArrayRow = 1 To LastRowColumnA                                          ' Loop through all used rows of the sheet
        If Trim(InputArray(ArrayRow, 2)) = "Delete" Then                        '   If File in the row is marked for deletion then ...
            FileToDelete = InputArray(ArrayRow, 8) & InputArray(ArrayRow, 1)    '       Combine data columns to create full path of file to delete
'
            If Len(Dir$(FileToDelete)) > 0 Then                                 '       If FileToDelete exists then ...
                SetAttr FileToDelete, vbNormal                                  '           Set FileToDelete to a deletable status
                Kill FileToDelete                                               '           Permanently delete the FileToDelete
            End If
        End If
    Next                                                                        ' Loop back to check for next FileToDelete
End Sub

 

[johnnyL]

Might want to add 1 line of code right before the 'End Sub'

    MsgBox "Deletions Complete."

That will notify you when it is finished.

 

[eric5605]

This is fantastic, thank you soooo much. I did a test and it worked great. One thing I didn't think of is that this permanently deletes rather than recycle bin. How would I change this code to do the same thing but move the files to my recycle bin or I can set up a folder to move all the files to, which I will later permanently delete:
P:\_Files_for_Deletion (I can remove the underscores if needed)

 

[johnnyL]

How about:

Sub MoveFiles()
'
    Dim ArrayRow            As Long
    Dim LastRowColumnA      As Long
    Dim FSO                 As Object
    Dim DestinationFolder   As String
    Dim FileToMove          As String
    Dim InputArray          As Variant
'
    DestinationFolder = "P:\_Files_for_Deletion\"                               ' <--- Set this to the folder location to move files to
    LastRowColumnA = Range("A" & Rows.Count).End(xlUp).Row                      ' Find last row used in Column A
'
    InputArray = Range("A1:H" & LastRowColumnA)                                 ' Load all data from sheet into InputArray
'
    Set FSO = CreateObject("Scripting.Filesystemobject")
'
    For ArrayRow = 1 To LastRowColumnA                                          ' Loop through all used rows of the sheet
        If Trim(InputArray(ArrayRow, 2)) = "Delete" Then                        '   If File in the row is marked for deletion then ...
            FileToMove = InputArray(ArrayRow, 8) & InputArray(ArrayRow, 1)      '       Combine data columns to create full path of file to move
'
            If Len(Dir$(FileToMove)) > 0 Then                                   '       If FileToMove exists then ...

                FSO.MoveFile Source:=FileToMove, _
                        Destination:=DestinationFolder & InputArray(ArrayRow, 1)    '       Move the file
            End If
        End If
    Next                                                                        ' Loop back to check for next FileToMove
'
    MsgBox "Located files have been moved."                                     ' Notify user that the script has finished
End Sub

 

[eric5605]

Thank you! This works too, but runs into a error 58 for file already exists. The issue is that I am cleaning up a shared drive where people stored the same file in different folders (often different versions). Now that I'm finding those duplicates and trying to move them to one folder, the fact that some of the files have the same name is causing a problem.
Would it be possible to have the "deleted" files that I'm moving to this new folder have the whole file path as the file name so each is unique? Or can the code append a number to duplicate file names it is moving to the new folder so each file name is slightly unique. On the attached spreadsheet you can see how many file names are duplicated but have different file paths. Thanks so much for your patience with me!

 

[johnnyL]

If the file already exists, why make another copy of it with a different name? Why not just delete it if it already exists?

 

[eric5605]

Unfortunately, people often changed the file and stored it in a new location with the same file name. My intent is to store all of the files market for deletion (including duplicates) and hold them in a "Files for Deletion" folder for a few months. If nothing comes up, I'll then delete the whole "Files for Deletion" folder. If it is a big deal to program that, no worries.

This is an ridiculous project because people have left this network drive very unorganized with over 4TB of files. I'm trying to automate as much of the drive cleanup as I can. Thanks for your help. Again, if it is a pain to write something that would bring over the file path as the file name so they'd all be unique (or append a number on dup file names), no problem.

 

[johnnyL]

Try this:

Sub MoveOrRenameMoveFiles()
'
    Dim ArrayRow            As Long
    Dim LastRowColumnA      As Long
    Dim RenameCounter       As Long
    Dim FSO                 As Object
    Dim DestinationFolder   As String
    Dim FileToMove          As String
    Dim OriginalFileName    As String
    Dim InputArray          As Variant
'
    DestinationFolder = "P:\_Files_for_Deletion\"                                       ' <--- Set this to the folder location to move files to
    LastRowColumnA = Range("A" & Rows.Count).End(xlUp).Row                              ' Find last row used in Column A
'
    InputArray = Range("A1:H" & LastRowColumnA)                                         ' Load all data from sheet into InputArray
'
    Set FSO = CreateObject("Scripting.Filesystemobject")
'
    For ArrayRow = 1 To LastRowColumnA                                                  ' Loop through all used rows of the sheet
        If Trim(InputArray(ArrayRow, 2)) = "Delete" Then                                '   If File in the row is marked for deletion then ...
            FileToMove = InputArray(ArrayRow, 8) & InputArray(ArrayRow, 1)              '       Combine data columns to create full path of file to move
'
            If Len(Dir$(FileToMove)) > 0 Then                                           '       If FileToMove exists then ...
                If Dir$(DestinationFolder & InputArray(ArrayRow, 1)) = "" Then          '           If FileToMove not exist already in DestinationFolder
                    FSO.MoveFile Source:=FileToMove, _
                            Destination:=DestinationFolder & InputArray(ArrayRow, 1)    '               Move the FileToMove to DestinationFolder
                Else                                                                    '           Else ...
                    OriginalFileName = InputArray(ArrayRow, 1)                          '               Save the OriginalFileName
                    RenameCounter = 1                                                   '               Initialize RenameCounter to 1
'
                    Do Until Dir$(DestinationFolder & InputArray(ArrayRow, 1)) = ""     '               Loop until New file name not found in DestinationFolder
                        RenameCounter = RenameCounter + 1                               '                   Increment RenameCounter
                        InputArray(ArrayRow, 1) = OriginalFileName & _
                                "(" & RenameCounter & ")"                               '                   Save New file name to the InputArray
                    Loop                                                                '               Loop back
'
                    FSO.MoveFile Source:=FileToMove, _
                            Destination:=DestinationFolder & InputArray(ArrayRow, 1)    '               Move the FileToMove to DestinationFolder
                End If
            End If
        End If
    Next                                                                                ' Loop back to check for next FileToMove
'
    MsgBox "Located files have been moved."                                             ' Notify user that the script has finished
End Sub

That should append duplicate file names with '(2)' , '(3)', etc

 

[eric5605]

Thank you soooo much! This worked great and will save many hours of time. I really appreciate you sticking with me through my questions!!