VBA遍历目录

Question

**大家好，

我将在下面的脚本中包含搜索文件并仅导出文件夹中最新文件中的数据的功能。 我每周都会在文件夹中添加一个新文件，因此不希望复制旧的数据范围。

有人可以帮忙吗？**

---

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

如果使用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库参考 。