Сбор только новых из разных папок

[strannick]

Добрый день, уважаемые форумчане!
Прежде все файлы сваливались в одну папку и данные из них сводились в один файл вот таким кодом:

Sub ЗаполнениеСводного()
    Application.ScreenUpdating = False: Application.DisplayAlerts = False
    
    Dim coll As New Collection, wb As Workbook, sh As Worksheet, sh1 As Worksheet
    Mask = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, "*.xlsx")
    Set sh1 = Worksheets("лист 1")
    iLastRow = sh1.Cells(Rows.Count, 1).End(xlUp).Row
    Filename = Dir(Mask)
    While Filename <> ""    ' перебираем все файлы в текущей папке
        If Not Filename Like ThisWorkbook.Name & "*" Then coll.Add Filename
        Filename = Dir
    Wend

    On Error Resume Next
    For Each Item In coll
        Set wb = Workbooks.Open(Replace(ThisWorkbook.FullName, ThisWorkbook.Name, Item), , True)
        If Not wb Is Nothing Then
            Set sh = wb.Worksheets("не заполняется")
                        
                    sh.Range("A3").Copy sh1.Cells(iLastRow, 1)
                    sh.Range("B3:AS3").Copy sh1.Cells(iLastRow, 8)
                    iLastRow = iLastRow + 1
                   
            wb.Close False
        End If
    Next
    Application.DisplayAlerts = True
End Sub

Файлы все одинаковые, данные импортируются из листа в одинаковым именем и в определенном порядке, что видно из кода.
Сейчас возникла необходимости разнести файлы по подпапкам. То есть каждый файл в отдельную подпапку с именем, соответствующим имени файла. Например, файл primer.xlsx, а подпапка для него primer.ru. Помогите адаптировать под такую задачу код, чтобы он просматривал все подпапки и импортировал данные из тех файлов, которые там лежат. НО, можно ли сделать так, чтобы он импортировал данные только из новых файлов, то есть тех, которых еще нет в сводном файле. Вот эта строка кода:

sh.Range("A3").Copy sh1.Cells(iLastRow, 1)

импортирует в ячейку А3 сводного файла как раз название папки primer.ru, где лежит файл. Может организовать проверку имени проверяемой папки с содержимым столбца А начиная со строки 3 и, в случае совпадения, не импортировать данные из файла, который там лежит?
Заранее спасибо!

[strannick]

Умом понял. Надо перебрать все подпапки в папке, имена подпапок загнать в коллекцию, сравнить с именами, уже имеющимися именами в столбце А сводного файла, при совпадении пропускаем, в противном случае копируем данные. Так?
Подскажите как собрать в коллекцию имена всех вложенных папок?

[Hugo121]

Зачем подпапки?
У Educated Fool на сайте есть код filenamescollection: http://excelvba.ru/code/FilenamesCollection
Функция VBA для получения списка файлов из папки,
с учётом выбранной глубины поиска в подпапках
У каждого файла ведь уникальное полное имя, не перепутаете.

Уже имеющиеся загоняете в словарь, затем оперативно проверяете все файлы по этому словарю - если ещё нет, значит надо брать