使用动态文件名循环浏览子文件夹和文件

Question

我下面的代码循环遍历子文件夹和文件，以打开具有特定文件名的文件（文件名的格式为“ Daily Report dd-mm-yyyy DAY-END.xlsx”或“ Weekly Report dd- mm-yyyy DAY-END.xlsx“），复制并粘贴相关数据，然后关闭工作簿。文件名是动态的，并且基于我的MASTER excel。我正在努力查看fso在子文件夹和文件中运行的顺序背后的逻辑，这意味着某些文件会根据其名称丢失（不幸的是，它们都没有相同的命名约定，因此日期顺序不正确） ），我必须再次手动运行代码以再次查找最后一行。

如果找到相关文件，有人可以帮我如何退出子文件夹循环，重新定义lastrow和文件名，然后根据新文件名再次启动子文件夹/ CurrFile循环吗？理想情况下，我希望它一直运行到文件名包含今天的日期为止。

Sub LoopSubfoldersAndFiles()

Dim fso As Object 
Dim folder As Object
Dim subfolders As Object
Dim filename As String
Dim wb As Workbook
Dim CurrFile As Object
Dim lastrow As Long
Dim MASTERwb As Workbook
Dim MASTERws As Worksheet
Dim MASTER As String
MASTER = "MASTER Report.xlsm"

    With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
    End With

Set MASTERwb = Workbooks(MASTER) 'define this workbook
Set MASTERws = MASTERwb.Sheets("Sheet1") 'define this worksheet
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(“\\....\”)
Set subfolders = folder.subfolders

    lastrow = MASTERws.Cells(Rows.Count, "D").End(xlUp).Row 'find the last filled row in column D
    filename = MASTERws.Cells(lastrow + 1, 1).Value 'set filename as the cell reference in column A of the first empty row (column A contains the exact filename corresponding to a certain date)

For Each subfolders In subfolders

    Set CurrFile = subfolders.Files

    For Each CurrFile In CurrFile
        If CurrFile.Name = filename Then
            Set wb = Workbooks.Open(subfolders.Path & "\" & filename) 
            [code to copy and paste relevant data from file to MASTER]
            wb.Close SaveChanges:=False 'close workbook
        End If

    lastrow = MASTERws.Cells(Rows.Count, "D").End(xlUp).Row ‘redefine lastrow 
    filename = MASTERws.Cells(lastrow + 1, 1).Value ‘redefine filename 

    Next

Next

Set fso = Nothing
Set folder = Nothing
Set subfolders = Nothing

With Application
.EnableEvents = True
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With

End Sub

Answer 1

您可能需要如下更改两个循环：

For Each folder In subfolders

    For Each CurrFile In subfolders.Files
        If CurrFile.Name = filename Then
            Set wb = Workbooks.Open(subfolders.Path & "\" & filename)
            [code to copy and paste relevant data from file to MASTER]
            wb.Close SaveChanges:=False 'close workbook

            lastrow = MASTERws.Cells(Rows.Count, "D").End(xlUp).Row 'redefine lastrow
            filename = MASTERws.Cells(lastrow + 1, 1).Value 'redefine filename
            Exit For
        End If
    Next

Next

但是您的措词含糊不清，如果以上内容不能解决您的问题，您可能希望对其进行增强