Move all files except recent one to another folder.

[Ananthak275]

Hi,

I'm trying to create a VBA where it moves all the files except the most recent one to a new folder (example; //documents/data/))

The file names are consistent format (Example: FileName-2021-07-28). as the only thing that changes is the date. For example, within a folder it can contain these files;
FileName-2021-07-28.xlsx
FileName-2021-07-27.xlsx
FileName-2021-07-26.xlsx

move files both 27 and 26.

 

[John_w]

Try this macro, changing the folder paths as needed.

Public Sub Move_Files_Except_Most_Recent()

    Dim fromFolder As String, toFolder As String, filename As String
    Dim filesArray As Object
    Dim i As Long
    
    fromFolder = "C:\folder\path\"
    toFolder = "C:\another\folder\"
    
    If Right(fromFolder, 1) <> "\" Then fromFolder = fromFolder & "\"
    If Right(toFolder, 1) <> "\" Then toFolder = toFolder & "\"
    
    Set filesArray = CreateObject("System.Collections.ArrayList")
    
    filename = Dir(fromFolder & "*.xlsx")
    Do While filename <> vbNullString
        i = InStrRev(filename, "-", InStrRev(filename, "-", InStrRev(filename, "-") - 1) - 1)
        filesArray.Add Mid(filename, i + 1) & "|" & filename
        filename = Dir()
    Loop
    
    filesArray.Sort
    
    For i = 0 To filesArray.Count - 2
        Name fromFolder & Split(filesArray(i), "|")(1) As toFolder & Split(filesArray(i), "|")(1)
    Next
    
End Sub

 

[Ananthak275]

Try this macro, changing the folder paths as needed.

Public Sub Move_Files_Except_Most_Recent()

    Dim fromFolder As String, toFolder As String, filename As String
    Dim filesArray As Object
    Dim i As Long
   
    fromFolder = "C:\folder\path\"
    toFolder = "C:\another\folder\"
   
    If Right(fromFolder, 1) <> "\" Then fromFolder = fromFolder & "\"
    If Right(toFolder, 1) <> "\" Then toFolder = toFolder & "\"
   
    Set filesArray = CreateObject("System.Collections.ArrayList")
   
    filename = Dir(fromFolder & "*.xlsx")
    Do While filename <> vbNullString
        i = InStrRev(filename, "-", InStrRev(filename, "-", InStrRev(filename, "-") - 1) - 1)
        filesArray.Add Mid(filename, i + 1) & "|" & filename
        filename = Dir()
    Loop
   
    filesArray.Sort
   
    For i = 0 To filesArray.Count - 2
        Name fromFolder & Split(filesArray(i), "|")(1) As toFolder & Split(filesArray(i), "|")(1)
    Next
   
End Sub

Perfect, thank you!