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]

Try this out:

Sub Move_DeleteFilesV1()
'
    Dim ArrayRow                As Long
    Dim LastRowColumnA          As Long
    Dim UndeletedFileCounter    As Long
    Dim ArchivePath             As String
    Dim FileToArchive           As String
    Dim FileToDelete            As String
    Dim UndeletedFileArray()    As String
    Dim InputArray              As Variant
'
    ArchivePath = "P:\Archive\"                                                 ' <--- Set this to the Archive path to be used
'
    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
    UndeletedFileCounter = 0                                                    ' Initialize UndeletedFileCounter
'
'-------------------------------------------------------------------------------
'
    For ArrayRow = 1 To LastRowColumnA                                          ' Loop through all used rows of the sheet
        If LCase(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 Right(FileToDelete, 1) <> "\" Then FileToDelete = FileToDelete & "\" '       Append '\' to end of path if not already there
'
            On Error GoTo ErrorHandler                                          '       Enable our error-handling routine.
            If Dir$(FileToDelete) <> "" Then                                    '       If FileToDelete exists then ...
                SetAttr FileToDelete, vbNormal                                  '               Set FileToDelete to a deletable status
                Kill FileToDelete                                               '               Permanently delete the FileToDelete
            End If
        ElseIf LCase(Trim(InputArray(ArrayRow, 2))) = "archive" Then            '   If File in the row is marked for Archive then ...
            FileToArchive = InputArray(ArrayRow, 8) & InputArray(ArrayRow, 1)    '       Combine data columns to create full path of file to archive
            If Right(FileToArchive, 1) <> "\" Then FileToArchive = FileToArchive & "\"  '       Append '\' to end of path if not already there
'
            If Dir$(FileToArchive) <> "" Then                                    '       If FileToArchive exists then ...
                If Dir$(ArchivePath, vbDirectory) <> "" Then                     '           If ArchivePath exists then ...
                    Name FileToArchive As ArchivePath & InputArray(ArrayRow, 1) '               Move the file
                End If
            End If
        End If
CheckNextFile:
        On Error GoTo 0                                                         '   Return Error handling back over to Excel
    Next                                                                        ' Loop back to check for next FileToDelete
'
'-------------------------------------------------------------------------------
'
    If Not Not UndeletedFileArray Then                                          ' If any files couldn't be deleted then ...
'
        Sheets.Add(Before:=Sheets(1)).Name = "Undeleted Files"                  '   Add a sheet called 'Undeleted Files' to store any files that weren't deleted
'
        Sheets("Undeleted Files").Range("A1").Resize(UBound(UndeletedFileArray)) _
                = Application.Transpose(UndeletedFileArray)                     '   Display the undeleted file names to the added sheet
        Sheets("Undeleted Files").Columns(1).AutoFit                            '   Adjust the column width of column A to display entire file names
    End If
'
    MsgBox "Script has completed."                                              ' Notify the user that the script has completed
    Exit Sub                                                                    ' exit the sub
'
'-------------------------------------------------------------------------------
'
ErrorHandler:
    UndeletedFileCounter = UndeletedFileCounter + 1                             ' Increment UndeletedFileCounter
    ReDim Preserve UndeletedFileArray(1 To UndeletedFileCounter)                ' Increase the size of the UndeletedFileArray
    UndeletedFileArray(UndeletedFileCounter) = FileToDelete                     ' Save the file path and name of the file that wasn't deleted into UndeletedFileArray
    Resume CheckNextFile                                                        ' Remove error encountered and return back to check for the next file
End Sub

That should allow you to delete as well as archive at the same time if you wanted to. In other words, you don't have to do them separately unless you wanted to. You could have some files marked for delete and other files marked for archive.

 

[eric5605]

Thanks so much! I am getting an error "Run-time error '52': Bad file name or number" Here is a copy of the test worksheet I used. I crated a folder on our P: drive, which is P:\Archive and changed the name in the macro as such. Also attached is an image of the error log.

 

[johnnyL]

Sorry, serves me right for not testing it.

Sub Move_DeleteFilesV1A()
'
    Dim ArrayRow                As Long
    Dim LastRowColumnA          As Long
    Dim UndeletedFileCounter    As Long
    Dim ArchivePath             As String
    Dim FileToArchive           As String
    Dim FileToDelete            As String
    Dim UndeletedFileArray()    As String
    Dim InputArray              As Variant
'
    ArchivePath = "P:\Archive\"                                                 ' <--- Set this to the Archive path to be used
'
    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
    UndeletedFileCounter = 0                                                    ' Initialize UndeletedFileCounter
'
'-------------------------------------------------------------------------------
'
    For ArrayRow = 1 To LastRowColumnA                                          ' Loop through all used rows of the sheet
        If LCase(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 Right(FileToDelete, 1) <> "\" Then FileToDelete = FileToDelete & "\" '       Append '\' to end of path if not already there
'
            On Error GoTo ErrorHandler                                          '       Enable our error-handling routine.
            If Dir$(FileToDelete) <> "" Then                                    '       If FileToDelete exists then ...
                SetAttr FileToDelete, vbNormal                                  '               Set FileToDelete to a deletable status
                Kill FileToDelete                                               '               Permanently delete the FileToDelete
            End If
        ElseIf LCase(Trim(InputArray(ArrayRow, 2))) = "archive" Then            '   If File in the row is marked for Archive then ...
            FileToArchive = InputArray(ArrayRow, 8) & InputArray(ArrayRow, 1)    '       Combine data columns to create full path of file to archive
'
            If Dir$(FileToArchive) <> "" Then                                    '       If FileToArchive exists then ...
                If Dir$(ArchivePath, vbDirectory) <> "" Then                     '           If ArchivePath exists then ...
                    Name FileToArchive As ArchivePath & InputArray(ArrayRow, 1) '               Move the file
                End If
            End If
        End If
CheckNextFile:
        On Error GoTo 0                                                         '   Return Error handling back over to Excel
    Next                                                                        ' Loop back to check for next FileToDelete
'
'-------------------------------------------------------------------------------
'
    If Not Not UndeletedFileArray Then                                          ' If any files couldn't be deleted then ...
'
        Sheets.Add(Before:=Sheets(1)).Name = "Undeleted Files"                  '   Add a sheet called 'Undeleted Files' to store any files that weren't deleted
'
        Sheets("Undeleted Files").Range("A1").Resize(UBound(UndeletedFileArray)) _
                = Application.Transpose(UndeletedFileArray)                     '   Display the undeleted file names to the added sheet
        Sheets("Undeleted Files").Columns(1).AutoFit                            '   Adjust the column width of column A to display entire file names
    End If
'
    MsgBox "Script has completed."                                              ' Notify the user that the script has completed
    Exit Sub                                                                    ' exit the sub
'
'-------------------------------------------------------------------------------
'
ErrorHandler:
    UndeletedFileCounter = UndeletedFileCounter + 1                             ' Increment UndeletedFileCounter
    ReDim Preserve UndeletedFileArray(1 To UndeletedFileCounter)                ' Increase the size of the UndeletedFileArray
    UndeletedFileArray(UndeletedFileCounter) = FileToDelete                     ' Save the file path and name of the file that wasn't deleted into UndeletedFileArray
    Resume CheckNextFile                                                        ' Remove error encountered and return back to check for the next file
End Sub

 

[eric5605]

Soooooo close. The macro runs, but I am getting Runtime error '53': File Not Found. Could it be that it is getting stuck on a corrupt file. You added an error handler for the "Delete" files and it works well. Does that error handler also work for files marked "Archive"? Thank you!!

 

[johnnyL]

What would you like to happen when the file(s) produce the error?

 

[eric5605]

The same thing you have set up for when macro is trying to delete a file worked great. It created a new tab and listed any file the macro tried to delete but could not. All of those have turned out to be corrupt files. I suspect that's the same thing that's happening for some of the files I'm marking to archive. I'm archiving based on dates (I don't inspect every file) and I don't know which files may be corrupt. There have been about 300 or so from he deletes that were corrupt. When I went back and found those individual files, they would not open. This library is such a mess and people moved files so much, I'm not surprised some (out of tens of thousands) are corrupt.

It is okay if the script puts all files it cannot move or delete in the same worksheet. I'll just know that all of those files are corrupt and I'll have to go back and find them myself using the folder path. Thank you!

 

[johnnyL]

Try the following:

Sub Move_DeleteFilesV1B()
'
    Dim ArrayRow                As Long, LastRowColumnA     As Long
    Dim ProblemFileCounter      As Long
    Dim ArchivePath             As String
    Dim FileToProcess           As String
    Dim ProblemFilesArray()     As String
    Dim ProblemSheetName        As String
    Dim InputArray              As Variant
'
    ArchivePath = "P:\Archive\"                                                 ' <--- Set this to the Archive path to be used
    ProblemSheetName = "Problem Files"                                          ' <--- Set this to the name of the sheet to be added to store
'                                                                               '           the names of files that were not processed properly
    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
    ProblemFileCounter = 0                                                      ' Initialize ProblemFileCounter
'
'-------------------------------------------------------------------------------
'
    For ArrayRow = 1 To LastRowColumnA                                          ' Loop through all used rows of the sheet
        If LCase(Trim(InputArray(ArrayRow, 2))) = "delete" Or _
                LCase(Trim(InputArray(ArrayRow, 2))) = "archive" Then           '   If File in the row is marked for archive or deletion then ...
            InputArray(ArrayRow, 8) = Trim(InputArray(ArrayRow, 8))             '       Remove forward and trailing spaces from path
'
            If Right$(InputArray(ArrayRow, 8), 1) <> "\" Then _
                    InputArray(ArrayRow, 8) = InputArray(ArrayRow, 8) & "\"     '       Append a '\' to end of path name if not already there
'
            FileToProcess = InputArray(ArrayRow, 8) & Trim(InputArray(ArrayRow, 1)) '       Combine data columns to create full path of file to archive
        End If
'
        If LCase(Trim(InputArray(ArrayRow, 2))) = "delete" Then                 '   If File in the row is marked for deletion then ...
            On Error GoTo ErrorHandler                                          '       Enable our error-handling routine.
            If Dir$(FileToProcess) <> "" Then                                   '       If FileToProcess exists then ...
                SetAttr FileToProcess, vbNormal                                 '               Set FileToProcess to a deletable status
                Kill FileToProcess                                              '               Permanently delete the FileToProcess
            End If
        ElseIf LCase(Trim(InputArray(ArrayRow, 2))) = "archive" Then            '   If File in the row is marked for Archive then ...
            On Error GoTo ErrorHandler                                          '       Enable our error-handling routine.
            If Dir$(FileToProcess) <> "" Then                                   '       If FileToProcess exists then ...
                If Dir$(ArchivePath, vbDirectory) <> "" Then                    '           If ArchivePath exists then ...
                    Name FileToProcess As ArchivePath & InputArray(ArrayRow, 1) '               Move the file
                End If
            End If
        End If
CheckNextFile:
        On Error GoTo 0                                                         '   Return Error handling back over to Excel
    Next                                                                        ' Loop back to check for next FileToProcess
'
'-------------------------------------------------------------------------------
'
    If Not Not ProblemFilesArray Then                                           ' If any files couldn't be deleted then ...
'
        Sheets.Add(Before:=Sheets(1)).Name = ProblemSheetName                   '   Add a sheet to store the file names that weren't processed properly
'
        Sheets(ProblemSheetName).Range("A1").Resize(UBound(ProblemFilesArray)) _
                = Application.Transpose(ProblemFilesArray)                      '   Display the problem file names to the added sheet
        Sheets(ProblemSheetName).Columns(1).AutoFit                             '   Adjust the column width of column A to display entire file names
    End If
'
    MsgBox "Script has completed."                                              ' Notify the user that the script has completed
    Exit Sub                                                                    ' exit the sub
'
'-------------------------------------------------------------------------------
'
ErrorHandler:
    ProblemFileCounter = ProblemFileCounter + 1                                 ' Increment ProblemFileCounter
    ReDim Preserve ProblemFilesArray(1 To ProblemFileCounter)                   ' Increase the size of the ProblemFilesArray
    ProblemFilesArray(ProblemFileCounter) = FileToProcess                       ' Save the file path and name of the file that wasn't processed into ProblemFilesArray
    Resume CheckNextFile                                                        ' Remove error encountered and return back to check for the next file
End Sub

I can't test the error handling because I don't have your files that cause the error(s), but let me know how the error page looks when the script finishes.

 

[eric5605]

Thank you so much Johnny. This did the trick. Very appreciated! Have a great weekend.

 

[johnnyL]

Glad to help. You have great weekend also.