VBA遍历目录

Question

**Hi All,

I would to incorporate into the below script the ability to search through files and export ONLY the data from the most recent file in folder. I will be adding a new file every week into folder so do not want the old data range to be copied across.

Can someone please help?**

---

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

Answer 1

If you use FileSystemObject it can be done using the .DateLastModified property. The below code should get you started:

Untested

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

Note: This code is looking for the most recent modified date. So this will only work if the newest file was created after any modifications in other files in the folder. Also, you may need to enable the Microsoft Scripting Runtime library reference .