Excel VBA Macro: Open Newest Files (from Multiple Folders) and Save Them in Another Folder

Описание к видео Excel VBA Macro: Open Newest Files (from Multiple Folders) and Save Them in Another Folder

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 (YouTube 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

Комментарии

Информация по комментариям в разработке