Need help editing list, move, and delete file macros

[pawest]

Dear MrExcel Experts,

I am an intern trying to catalog over 100K old files. I am using a main worksheet to specify the parameters of what files I need. The parameters include specifying which drive I want to search, if I want to include Subfolders, specifying a date to gather files prior to, and specifying folders not to search. I also need to move those files to a "Stale Files" folder and then delete the old files. The code references cells from a main worksheet and adds the gathered files to a new sheet. There is another sheet for moving the files and another for deleting them. Here is the code I have so far:


Code:


Sub ListFiles()
On Error Resume Next
Sheets.Add
Call CreateList
Call MsgBeSure
End Sub
Sub CreateList()
Dim filePath As Variant, fsObject As Variant, file As Variant
Dim i As Long
Dim Lastrow As Long
Lastrow = Worksheets("Parameters").Range("F65536").End(xlUp).Row

With Application.FileSearch
.LookIn = Range("Drive")
.SearchSubFolders = Range("Include_Subfolders")
.Filename = "*.*"
.Execute

For Each filePath In .FoundFiles
i = 1 + i
Set fsObject = CreateObject("Scripting.FileSystemObject")
Set file = fsObject.GetFile(filePath)
ActiveSheet.Cells(i, 1) = file.Drive
ActiveSheet.Cells(i, 2) = file.Name
ActiveSheet.Cells(i, 3) = file.ParentFolder
For Counter = 18 To Lastrow
Set PFcell = Worksheets("Parameters").Cells(Counter, 6)
If PFcell.Value = file.ParentFolder Then Exit Sub
Next Counter
ActiveSheet.Cells(i, 4) = file.Path
ActiveSheet.Cells(i, 5) = file.DateLastModified
If file.DateLastModified >= Worksheets("Parameters").Range("Before_Date").Value Then Exit Sub
Next filePath
.NewSearch

End With
End Sub
Sub MsgBeSure()
MsgBox "Do NOT move or delete gathered, stale data before consulting with your coworkers and supervisors and receiving their input. Be sure to sort and assess the gathered, stale data for file sequences or data that should not be deleted."
End Sub

Sub Move_Rename_Folder()
Dim FSO As Object
Dim FromPath As String
Dim ToPath As String
Dim Lastrow As Long

Lastrow = Worksheets("Sheet3").Range("D65536").End(xlUp).Row
If MsgBox("Are you sure you want to move all gathered, stale files?", vbYesNo) <> vbYes Then Exit Sub
If MsgBox("Are you sure you want to move all gathered, stale files?", vbYesNo) = vbYes Then
For Counter = 1 To Lastrow
Set Pathcell = Worksheets("Sheet3").Cells(Counter, 4)
FromPath = Worksheets("Sheet3").Cells(Counter, 4)
ToPath = Worksheets("Parameters").Range("Drive").Value & "Stale Files" & Left(FromPath, Len(FromPath) - 2)
' If Right(FromPath, 1) = "\" Then
' FromPath = Left(FromPath, Len(FromPath) - 1)
' End If
'
' If Right(ToPath, 1) = "\" Then
' ToPath = Left(ToPath, Len(ToPath) - 1)
' End If
Set FSO = CreateObject("scripting.filesystemobject")
' If FSO.FolderExists(ToPath) = True Then
' MsgBox ToPath & " exist, not possible to move to a existing folder"
' Exit Sub
' End If
FSO.MoveFolder Source:=FromPath, Destination:=ToPath
Next Counter
End If
End Sub


Sub Delete_Files()
Dim Lastrow As Long
Lastrow = Worksheets(Range("Sheet_Name")).Range("D65536").End(xlUp).Row

If MsgBox("Are you sure you want to delete all gathered, stale files?", vbYesNo) <> vbYes Then Exit Sub
If MsgBox("Are you sure you want to delete all gathered, stale files?", vbYesNo) = vbYes Then
For Counter = 1 To Lastrow
Set StaleCell = Worksheets(Range("Sheet_Name")).Cells(Counter, 4)
Kill StaleCell
Next Counter

End Sub


There are many issues with this code. It references cells on pages which I have not explained in much but am assuming one can figure out. I would appreciate any help. I orginally posted this with less code and this is the updated version.

Thanks for your consideration to help!<!-- / message -->