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

注意：此代码正在查找最近的已修改日期。因此，只有在文件夹中的其他文件中进行任何修改后，创建了最新文件才能生效。此外，您可能需要enable the Microsoft Scripting Runtime library reference。

VBA循环目录

1 个答案: