Цикл VBA через каталог

**Всем привет,

Я хотел бы включить в приведенный ниже сценарий возможность поиска файлов и экспортировать ТОЛЬКО данные из самого последнего файла в папке. Я буду добавлять новый файл каждую неделю в папку, поэтому не нужно копировать старый диапазон данных.

Кто-нибудь может помочь? **

Sub loopthroughdirectory()
Dim myfile As String
Dim erow
fileroot = "C:\Users\ramandeepm\Desktop\consolidate\"
myfilename = Dir("C:\Users\ramandeepm\Desktop\consolidate\")

Do While Len(myfilename) > 7

 If myfilename = "zmaster.xlsm" Then
 Exit Sub
 End If

 myfile = fileroot & myfilename
 Workbooks.Open (myfile)
 Range("range").Copy
 ActiveWorkbook.Close

 erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
 ActiveSheet.Paste Destination:=Worksheets("sheet1").Range(Cells(erow, 1), Cells(erow, 4))

 myfilename = Dir()

Loop

End Sub
1 ответ

Если вы используете FileSystemObject это можно сделать, используя свойство .DateLastModified. Код ниже должен начать:

Непроверенные

Dim FSO As FileSystemObject
Dim objFile As File
Dim myFolder
Dim strFilename As String
Dim dtFile As Date

'set folder location
Const myDir As String = "C:\Users\ramandeepm\Desktop\consolidate"

'set up filesys objects
Set FSO = New FileSystemObject
Set myFolder = FSO.GetFolder(myDir)

'loop through each file and get date last modified. If largest date then store Filename
dtFile = DateSerial(1900, 1, 1)
For Each objFile In myFolder.Files
 If Len(objFile.Name) > 7 Then
 If objFile.DateLastModified > dtFile Then
 dtFile = objFile.DateLastModified
 strFilename = objFile.Name
 End If
 End If
Next objFile
Workbooks.Open strFilename

Примечание. Этот код ищет самую последнюю измененную дату. Таким образом, это будет работать, только если новый файл был создан после любых изменений в других файлах в папке. Кроме того, вам может потребоваться включить ссылку на библиотеку Microsoft Scripting Runtime.

licensed under cc by-sa 3.0 with attribution.