L oop через подпапки и файлы, используя имя файла Dynami c - PullRequest
Новая
       14

L oop через подпапки и файлы, используя имя файла Dynami c

0 голосов
/ 31 марта 2020

У меня есть код ниже, который просматривает мои подпапки и файлы, чтобы открыть файл с указанным c именем файла (имя файла либо в форме "Ежедневный отчет dd-mm-yyyy DAY-END.xlsx", либо " Еженедельный отчет dd-mm-yyyy DAY-END.xlsx "), скопируйте и вставьте соответствующие данные, а затем закройте рабочую книгу. Имя файла - Dynami c и основано на моем MASTER Excel. Я изо всех сил пытаюсь увидеть логи c за порядком, в котором fso запускает подпапки и файлы, что означает, что некоторые файлы пропускаются по их имени (к сожалению, не все они имеют одинаковое соглашение об именах, поэтому не имеют в порядке дат) и мне нужно снова вручную запустить код для поиска последней строки.

Может кто-нибудь помочь мне с выходом из подпапки l oop ЕСЛИ соответствующий файл найден, переопределите последнюю строку и имя файла, а затем снова запустите подпапку / CurrFile l oop на основе нового имени файла? В идеале я хочу, чтобы это работало, пока имя файла не содержит сегодняшнюю дату. 

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

1 Ответ

1 голос
/ 31 марта 2020

вам может понадобиться изменить два цикла следующим образом: 

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

, но ваша формулировка несколько расплывчата, и вы можете улучшить ее, если то, что выше, не решит ваш вопрос

...