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

[bcmom87]

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

 

[bcmom87]

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"

 

[John_w]

For 1, add a back slash to end of the paths. For 2, you need a recursive FileSystemObject project.

Please use CODE tags.

 

[bcmom87]

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.

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

 

[John_w]

The second folder should be strDest = ....

 

[bcmom87]

Thank you very much. This works. I appreciate your time.