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

[vhrame]

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.

[rajiv_h]

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/questions/28358767/Copy-only-last-file-in-a-folder-to-another-folder-using-robocopy.html

[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.



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

[rajiv_h]

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?

[snb]

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

[vhrame]

Thank you so much for help!