Copy most recent files from one directory to another with option to use specific date range

bcmom87

New Member
Joined
Jan 30, 2018
Messages
4
Hello,

I have 2 goals.

1) One macro to copy the most recent .xlsx files (based on saved date) from one directory to another, where I state the specific source and target paths
2) One macro that is similar to the one above, but allows me to state a saved date range in the code, find ALL .xlsx files in any folder beneath a specific parent folder (in other words, all subfolders), and copy these to one specified target folder

Below is the code I am using for #1 . It runs, but does not find the files in my source folder. I am guessing my strpath statements are not correct.

I am looking for a correction to my code, which will solve #1 and suggestions for a second macro to solve #2 .

Thanks in advance for assistance with this.


Sub Open_Latest_File_Copy_Move()
Dim strPath As String
Dim strDest As String
Dim myFile As String
Dim LatestFile As String
Dim LatestDate As Date
Dim Lmd As Date
Dim Wb As Workbook
Dim fso As Object


'The Folder 'Version 1' Contains The File To Be Checked
strPath = "V:\2018\Variance Files\Version 1"


'The Folder 'Version 2' Where The File Will Be Moved
strPath = "B:\2018\Variance Files\Version 2"

Set fso = VBA.CreateObject("Scripting.FileSystemObject")
myFile = Dir(strPath & "*.xls*", vbNormal)

If Len(myFile) = 0 Then
MsgBox "No Files Were Found...", vbExclamation
Exit Sub
End If


Application.ScreenUpdating = False
Application.DisplayAlerts = False
Do While Len(myFile) > 0
Lmd = FileDateTime(strPath & myFile)

If Lmd > LatestDate Then
LatestFile = myFile
LatestDate = Lmd
End If

myFile = Dir
Loop

Set Wb = Workbooks.Open(strPath & LatestFile)

Wb.Sheets("Sheet1").UsedRange.Copy ThisWorkbook.Sheets("Sheet1").Range("A1")
Wb.Close SaveChanges:=False

strPath = strPath & LatestFile
Call fso.CopyFile(strPath, strDest)
Kill strPath
Application.ScreenUpdating = True
Application.DisplayAlerts = True


Set Wb = Nothing
MsgBox "Done...", 64
End Sub
 

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off
Correction.

My code to copy to the target folder is:

'The Folder 'Version 2' Where The File Will Be Moved
strPath = "B:\2018\Variance Files\Version 2"
 
Upvote 0
For 1, add a back slash to end of the paths. For 2, you need a recursive FileSystemObject project.

Please use CODE tags.
 
Upvote 0
For 1, add a back slash to end of the paths. For 2, you need a recursive FileSystemObject project.

Please use CODE tags.

Thank you for the response. I have looked up the meaning of CODE tags and placed them below. I added the back slash but I still get "No files were found" error.

Rich (BB code):
Rich (BB code):
Rich (BB code):
Sub Open_Latest_File_Copy_Move()
Dim strPath As String
Dim strDest As String
Dim myFile As String
Dim LatestFile As String
Dim LatestDate As Date
Dim Lmd As Date
Dim Wb As Workbook
Dim fso As Object


'The Folder 'Version 1' Contains The File To Be Checked
strPath = "V:\2018\Variance Files\Version 1\"


'The Folder 'Version 2' Where The File Will Be Moved
strPath = "B:\2018\Variance Files\Version 2\"

Set fso = VBA.CreateObject("Scripting.FileSystemObject")
myFile = Dir(strPath & "*.xls*", vbNormal)

If Len(myFile) = 0 Then
MsgBox "No Files Were Found...", vbExclamation
Exit Sub
End If


Application.ScreenUpdating = False
Application.DisplayAlerts = False
Do While Len(myFile) > 0
Lmd = FileDateTime(strPath & myFile)

If Lmd > LatestDate Then
LatestFile = myFile
LatestDate = Lmd
End If

myFile = Dir
Loop

Set Wb = Workbooks.Open(strPath & LatestFile)

Wb.Sheets("Sheet1").UsedRange.Copy ThisWorkbook.Sheets("Sheet1").Range("A1")
Wb.Close SaveChanges:=False

strPath = strPath & LatestFile
Call fso.CopyFile(strPath, strDest)
Kill strPath
Application.ScreenUpdating = True
Application.DisplayAlerts = True


Set Wb = Nothing
MsgBox "Done...", 64
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,484
Messages
6,113,924
Members
448,533
Latest member
thietbibeboiwasaco

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top