View Full Version : [SOLVED:] How to copy the most current file from one folder to another
vhrame
06-18-2020, 11:21 AM
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
06-21-2020, 09:11 AM
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
06-22-2020, 01:51 AM
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
06-23-2020, 02:54 AM
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.
vhrame
06-24-2020, 08:00 AM
Thank you so much for help!
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.