vbafilesystemobject

To pick one file at a time and move


I have two subs mentioned below.

The first sub gets the file modified dates and it is working.

The second sub moves files from one folder to another. Is it possible to merge these 2 subs together so that it first finds the oldest modified time and then moves it accordingly?

however, please also help to include a loop in it.

Sub test()
    Dim FSO As Object
    Dim fol As Object
    Dim fil As Object
    Dim temp As Date

    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set fol = FSO.GetFolder("E:\Source")

    For Each fil In fol.Files
        temp = fil.DateLastModified
    Next fil
    MsgBox temp
End Sub
Sub FSOMoveAllFiles()
    Dim FSO As New FileSystemObject
    Dim FromPath As String
    Dim ToPath As String
    Dim FileInFromFolder As Object

    FromPath = "E:\Source\"
    ToPath = "E:\Destination\"
   
    Set FSO = CreateObject("Scripting.FileSystemObject")

    For Each FileInFromFolder In FSO.GetFolder(FromPath).Files
        FileInFromFolder.Move ToPath
    Next FileInFromFolder
End Sub

Solution

  • Please, test the next function, able to return the oldest file (according to its creation time):

    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
    

    If you need last modified file you should replace File.DateCreated with File.Datelastmodified.

    It should be called from your code in the next way:

    Sub MoveOldestFile()
        Dim FromPath As String, ToPath As String, fileName As String
    
        FromPath = "E:\Source\"
        ToPath = "E:\Destination\"
       
        fileName = OldestFile(FromPath)
        If Dir(ToPath & fileName) = "" Then
            Name FromPath & fileName As ToPath & fileName
        Else
            MsgBox "File """ & fileName & """ already moved..."
        End If
    End Sub
    

    Each time when the above code is run, moves the oldest file to "ToPath" folder.

    Please, send some feedback after testing it.