How to copy the most current file from one folder to another

Hi,

i am hoping there is someone that can help me.

I am wanting to copy the most current file from one folder to another folder. I am wanting to do it without having to open an excel file. Also, i would like to rename the copied file too.

Thank you, any help is really appreciated.

If you don't want to open Excel, then, this is not an Excel problem. It's a shell problem. Check out this article:

https://www.experts-exchange.com/que...-robocopy.html

I have uploaded the file for you here https://www.udrop.com/7cr/CopyRecentFile.xlsm or you could also plug the below code into your module.

Code:

---

Option Explicit


Dim FileNames()            As Variant
Dim FSO                    As Object
Dim FileCounter            As Long
Const FinalFileName        As String = "BiFanatic" 'Change this name to your choice


Sub MoveRecentFile()


    Dim FD                      As FileDialog
    Dim IsSourceFolSelected    As Boolean
    Dim IsTargetFolSelected    As Boolean
    Dim SourceFolderPath        As String
    Dim RecentDate              As Date
    Dim RecentFileName          As String
    Dim x                      As Long
    Dim Fil                    As Object
    Dim TargetFolderPath        As String


    Set FD = Application.FileDialog(msoFileDialogFolderPicker)


    Do While IsSourceFolSelected = False Or IsTargetFolSelected = False 'Checks if both source and target folders are selected


        If IsSourceFolSelected = False Then
            FD.Title = "Select source folder"
            IsSourceFolSelected = FD.Show
            If Not IsSourceFolSelected = False Then
                SourceFolderPath = FD.SelectedItems(1)
                IsSourceFolSelected = True
            End If
        End If


        If IsTargetFolSelected = False Then
            FD.Title = "Select target folder"
            IsTargetFolSelected = FD.Show
            If Not IsTargetFolSelected = False Then
                TargetFolderPath = FD.SelectedItems(1)
                IsTargetFolSelected = True
            End If
        End If


    Loop


    Set FSO = CreateObject("Scripting.FileSystemObject")
    FileCounter = 1


    Call LoopOverFoldersAndSubFolders(SourceFolderPath, False) 'Change it to true if you want to loop over subfolders in a folder


    RecentDate = FileNames(2, 1)
   
    'check for the most recent date
   
    For x = 1 To UBound(FileNames, 2)
        If FileNames(2, x) > RecentDate Then
            RecentDate = FileNames(2, x)
            RecentFileName = FileNames(1, x)
        End If
    Next x


    Set Fil = FSO.GetFile(RecentFileName)
    Fil.Copy TargetFolderPath & "\" & FinalFileName & "." & FSO.GetExtensionName(Fil.Name)


    Set FSO = Nothing
    Erase FileNames


End Sub


Private Sub LoopOverFoldersAndSubFolders(SourceFolderPath As String, Optional LoopOverSubFolder As Boolean = False)


    Dim SourceFolder            As Object
    Dim SubFol                  As Object
    Dim Fil                    As Object


    Set SourceFolder = FSO.GetFolder(SourceFolderPath)


    For Each Fil In SourceFolder.Files
        ReDim Preserve FileNames(1 To 2, 1 To FileCounter)


        FileNames(1, FileCounter) = Fil.Path
        FileNames(2, FileCounter) = Fil.DateLastModified


        FileCounter = FileCounter + 1
    Next Fil


    If LoopOverSubFolder = True Then
        For Each SubFol In SourceFolder.SubFolders
            Call LoopOverFoldersAndSubFolders(SubFol.Path, True)
        Next SubFol
    End If


End Sub

---

Quote:

---

Originally Posted by BIFanatic

I have uploaded the file for you here https://www.udrop.com/7cr/CopyRecentFile.xlsm or you could also plug the below code into your module.

---

I wonder how this could be run without opening an Excel file?

As long as you use VBA some Office file has to be opened.

Thank you so much for help!