Moving oldest files first from source to destination

Question

I have more than 2000 files in a source which I was moving using the code below. The process was running but today (after two weeks) it gives

Run Time Error 58" "File Already Exist"

Upon checking there is no such file which is available in source and destination folder and all files names are separate from each other.

Even if both source and destination folders are empty it is giving the same error at the line Name FromPath & fileName As ToPath & fileName.

Function OldestFile(strFold As String) As String
    Dim FSO As Object, Folder As Object, File As Object, oldF As String
    Dim lastFile As Date: lastFile = Now
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set Folder = FSO.GetFolder(strFold)
    For Each File In Folder.Files
        If File.DateCreated < lastFile Then
            lastFile = File.DateCreated: oldF = File.Name
        End If
    Next
    OldestFile = oldF
End Function


Sub MoveOldestFile()
    Dim FromPath As String, ToPath As String, fileName As String, limit As Long
    FromPath = "C:\Users\user\Desktop\Source\"
    ToPath = "C:\Users\user\Desktop\Destination\"
    limit = 20
    filesmoved = 0
    fileName = OldestFile(FromPath)
    Do Until fileName = "" Or filesmoved = limit
        If Dir(ToPath & fileName) = "" Then
            Name FromPath & fileName As ToPath & fileName
            filesmoved = filesmoved + 1
        End If
        fileName = OldestFile(FromPath)
    Loop
End Sub

Answer 1

I cannot say that I understand the logic of your code as at the end it will move all files, no matter how old they are, so what do you achieve with the fact that you move the oldest file first?

Anyhow, what you could do is to skip system files (like desktop.ini) by checking the file attribute

Function OldestFile(strFold As String) As String
    Const ATTR_SYSTEM = 2
    Dim FSO As Object, Folder As Object, File As Object, oldF As String
    Dim lastFile As Date: lastFile = Now
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set Folder = FSO.GetFolder(strFold)
    For Each File In Folder.Files
        If (File.Attributes And ATTR_SYSTEM) = 0 And File.DateCreated < lastFile Then
            lastFile = File.DateCreated: oldF = File.Name
        End If
   Next
   OldestFile = oldF
End Function

Answer 2

change the following line:

If Dir(ToPath & fileName) = "" Then

to

If Dir(ToPath & fileName, 7) = "" Then

That line is failing to check for read only, system or hidden files. So your code tries to rename an existing hidden file.

Yo may want to try this variant of your code which should have a better performance in big directories as it does not iterate over the whole directory each time

Function OldestFile(strFold As String) As Variant
    Dim FSO As Object, Folder As Object, File As Object, oldF As String
    Dim lastFile As Date: lastFile = Now
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set Folder = FSO.GetFolder(strFold)
    Dim myarray As Variant
    If Folder.Files.Count > 0 Then
        ReDim myarray(Folder.Files.Count - 1)
        ix = 0
        For Each File In Folder.Files
            myarray(ix) = Format(File.DateCreated, "YYYYMMDDHHmmSS") & File.Name
            ix = ix + 1
        Next
        For i = LBound(myarray) To UBound(myarray) 'Sort according to date
            For j = i + 1 To UBound(myarray)
                If UCase(myarray(i)) > UCase(myarray(j)) Then
                    Temp = myarray(j)
                    myarray(j) = myarray(i)
                    myarray(i) = Temp
                End If
            Next j
        Next i
    End If
OldestFile = myarray
End Function


Sub MoveOldestFile()
    Dim FromPath As String, ToPath As String, fileName As String, limit As Long
    Dim fileArray As Variant
    FromPath = "C:\Users\user\Desktop\Source\"
    ToPath = "C:\Users\user\Desktop\Destination\"
    limit = 20
    filesmoved = 0
    fileArray = OldestFile(FromPath)
    If Not IsEmpty(fileArray) Then
        ix = 0
        Do Until ix > UBound(fileArray) Or filesmoved = limit
            fileName = Mid(fileArray(ix), 15)
            If Dir(ToPath & fileName, 7) = "" Then
                Name FromPath & fileName As ToPath & fileName
                filesmoved = filesmoved + 1
            End If
            ix = ix + 1
        Loop
    End If
End Sub