Excel VBA Macro: Open Newest Files (from Multiple Folders) and Save Them in Another Folder. In this video, we create code that checks a list of folders, pulls the latest file out of each one, and saves them all to another specified folder.
Code (KZread doesn't allow brackets; so LT and GT are used for less than and greater than, respectively):
Sub save_newest_files_to_folder()
Dim myPath As String
Dim myFile As String
Dim destination As String
Dim newestFile As String
Dim newestDate As Date
Dim fldr_count As Integer
Dim ws As Worksheet
Dim i As Integer
Dim check As Integer
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set ws = ThisWorkbook.Sheets("Sheet1")
fldr_count = WorksheetFunction.CountA(Range("A1", Range("A1").End(xlDown)))
destination = ws.Cells(2, 2).Text & "\"
For i = 2 To fldr_count
check = 0
myPath = ws.Cells(i, 1).Text & "\"
myFile = Dir(myPath)
newestFile = myFile
On Error GoTo noFiles
newestDate = FileDateTime(myPath & myFile)
Do While myFile LT GT ""
check = 1
If FileDateTime(myPath & myFile) GT newestDate Then
newestFile = myFile
newestDate = FileDateTime(myPath & myFile)
End If
myFile = Dir
Loop
Workbooks.Open Filename:=myPath & newestFile
ActiveWorkbook.SaveAs Filename:=destination & newestFile
ActiveWorkbook.Close
noFiles:
If check = 0 Then
MsgBox "There are no files in this folder: " & myPath
End If
Next i
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
#ExcelVBA #ExcelMacro