Код VBA, который проходит через папку для поиска подпапок и файлов?

Я пытаюсь написать код, который будет собирать файлы с похожим именем в подпапках. Например, основной папкой является «Отчеты», в которой есть вложенные папки «Отчеты \ 2015» (и другие годы), в каждом из которых находится месяц «Отчеты \ 2015 \ 01 jan 15», и в каждом из них находится файл, называемый «Отчеты \ 2015 \ 01 jan 15 \ DSR». Учитывая начальный месяц и год с и конец месяца и года, я пытаюсь собрать файлы с именем DSR. У меня есть пользователь из всех настроенных, но я застрял на этом. Все идеи? Спасибо. Вот что я до сих пор

EDIT: я обновил код

Public Sub NonRecursiveMethod() Dim fso, oFolder, oSubfolder, oFile, queue As Collection Dim years Dim yeare Dim months Dim monthe Dim Name Dim path1() As String years = "2012" yeare = "2015" months = "05" monthe = "09" Name = "DSR" Dim counter Set fso = CreateObject("Scripting.FileSystemObject") Set queue = New Collection queue.Add fso.getFolder("L:\Live\OES\DAILY OLD\") 'obviously replace i = 1 j = 1 q = 0 Do While queue.Count > 0 Set oFolder = queue(1) queue.Remove 1 'dequeue '...insert any folder processing code here... yearspot = Val(Mid(oFolder, 23, 4)) monthspot = Val(Mid(oFolder, 28, 2)) If yearspot = Val(years) Then If monthspot >= Val(months) Then Cells(i + 1, 1) = Mid(oFolder, 23, 4) Cells(i + 1, 2) = Mid(oFolder, 28, 2) ReDim Preserve path1(i) path1(i) = oFolder Cells(i + 1, 3) = path1(i) i = i + 1 End If ElseIf yearspot = Val(yeare) Then If monthspot <= Val(monthe) Then If monthspot > 0 Then ' MsgBox yearspot ' MsgBox monthspot Cells(i + 1, 1) = Mid(oFolder, 23, 4) Cells(i + 1, 2) = Mid(oFolder, 28, 2) ReDim Preserve path1(i) path1(i) = oFolder Cells(i + 1, 3) = path1(i) i = i + 1 End If End If Else If yearspot < Val(yeare) Then If yearspot > Val(years) Then If monthspot >= 1 Then If monthspot <= 12 Then Cells(i + 1, 1) = Mid(oFolder, 23, 4) Cells(i + 1, 2) = Mid(oFolder, 28, 2) ReDim Preserve path1(i) path1(i) = oFolder Cells(i + 1, 3) = path1(i) i = i + 1 End If End If End If End If End If For Each oSubfolder In oFolder.SubFolders queue.Add oSubfolder 'enqueue Next oSubfolder For Each oFile In oFolder.Files '...insert any file processing code here... ' For counter = 1 To UBound(path1) ' If path1(counter) = Mid(oFile, 1, 30) Then ' MsgBox path1(counter) ' End If ' Next counter Next oFile Loop End Sub 

Interesting Posts

Проблема с кодом VBA при объединении csv-файлов в виде книги с отдельными листами

Как экспортировать одну вертикальную таблицу столбцов со многими строками в лист Excel с заголовками на горизонтальной плоскости?

Заменить строку, используя макрос

Таблица. Создание новой строки между текстом с использованием вычисленного поля.

Считайте отличные, точные значения строк в Excel

C # Excel Interop: открытие и отображение файла CSV

Чтение четких данных с помощью PHPExcel

Как предотвратить изменение размера диаграммы из заданной высоты строки в poi

Создание «базы данных» с Excel с помощью VBA Userform

Как выбрать Range с помощью Chr

Почему apache poi SSPerformanceTest терпит неудачу на моей машине с предельной ошибкой GC overhead даже с входами, указанными в FAQ (XSSF 50000 50 1)

Как использовать string_agg в SQL в Excel Query

Удалить дубликаты VBA

Excel vba, разбить лист на разрыве страницы, сохранить как pdf, и autoname на основе значения

запрос для чтения данных с листа excel в c #

Давайте будем гением компьютера.