Excel VBA - рекурсивный поиск файлов по всем папкам (детализация), запись результатов в один и тот же массив не работает так хорошо, как коллекция

Question

Это мой первый пост - надеюсь, он хороший :) Небольшая задача для дома, я хотел бы получить массив всех путей к файлам в папке (и ее подпапках), но только для PDF или типа файла, по которому я советую фильтровать.

Мне больше нравятся массивы (и они могут очень быстро записывать в Range), я знаю, что могу преобразовать свой первый пример кода из коллекции в массив, но я хотел бы изучить и понять логику / синтаксис того, как реализовать мой пример 1, но используя только массивы.

Пример 1 работает (я пропустил другой бит кода, который я использую для отладки. Напечатайте его):

Sub GetAllFilePaths(StartFolder As String, Pattern As String, _
             ByRef colFiles As Collection)

    Dim f As String, sf As String, subF As New Collection, S

    If Right(StartFolder, 1) <> "\" Then StartFolder = StartFolder & "\"

    f = Dir(StartFolder & Pattern)
    Do While Len(f) > 0
        colFiles.Add StartFolder & f
        f = Dir()
    Loop

    sf = Dir(StartFolder, vbDirectory)
    Do While Len(sf) > 0
        If sf <> "." And sf <> ".." Then
            If (GetAttr(StartFolder & sf) And vbDirectory) <> 0 Then
                    subF.Add StartFolder & sf
            End If
        End If
        sf = Dir()
    Loop

    For Each S In subF
        GetAllFilePaths CStr(S), Pattern, colFiles
    Next S

End Sub

Пример 2 не совсем работает, кажется, он зацикливается на том, как я хочу, но переписывает массив, не добавляет к нему, поэтому не получает все известные мне PDF-файлы в глубокие подпапки.

Я думаю, что это способ, которым я обрабатывал добавление в массив, изменение размера и индекс, к которому я добавляю новое значение, я искал ... везде для некоторой помощи, даже здесь Рекурсивный поиск структуры файлов / папок , https://excelvirtuoso.net/2017/02/07/multi-dimensional-arrays/, Макрос VBA, который ищет файл в нескольких подпапках ,

Я знаю, что логика не совсем правильная, но, кажется, не могу понять это, любая помощь, пожалуйста ..

Код примера 2 (я ввожу, как я его называю, и использую Debug.Print для его проверки):

Option Explicit
Sub GetAllFilePaths(StartFolder As String, Pattern As String, ByRef allFilePaths As Variant, ByRef allFileNames As Variant)
    Dim FNum As Integer
    Dim mainFolder As Object
    Dim pathFile As String
    Dim subFoldersRecurs As New Collection, SubPath
    Dim SubFilePath As String

    If Right(StartFolder, 1) <> "\" Then StartFolder = StartFolder & "\"

    pathFile = Dir(StartFolder & Pattern)
    Do While Len(pathFile) > 0
        FNum = FNum + 1
        ReDim Preserve allFileNames(1 To FNum)
        ReDim Preserve allFilePaths(1 To FNum)
        allFileNames(FNum) = pathFile
        allFilePaths(FNum) = StartFolder & pathFile
        pathFile = Dir()
    Loop


    SubFilePath = Dir(StartFolder, vbDirectory)
    Do While Len(SubFilePath) > 0
        If SubFilePath <> "." And SubFilePath <> ".." Then
            If (GetAttr(StartFolder & SubFilePath) And vbDirectory) <> 0 Then
                subFoldersRecurs.Add StartFolder & SubFilePath
            End If
        End If
        SubFilePath = Dir()
    Loop

    For Each SubPath In subFoldersRecurs
        GetAllFilePaths CStr(SubPath), Pattern, allFilePaths, allFileNames
    Next SubPath

End Sub

Sub PDFfilestoCollall()
Dim pdfFilePaths() As Variant
Dim pdfFileNames() As Variant

Call GetAllFilePaths("C:\Users\adg\Downloads\test folder of files for ingest\", "*.PDF", pdfFilePaths, pdfFileNames)

Dim CollEntry As Variant
For Each CollEntry In pdfFilePaths
    Debug.Print CollEntry

Спасибо, ADG

Answer 1

Я перефразировал ваш код здесь.

Sub GetAllFilePaths(ByVal StartFolder As String, ByVal Pattern As String, _
    ByRef arrFiles() As String, Optional ByRef AddToArrayAt As Long = -1)

    Dim f As String
    Dim sf As String
    Dim subF As Collection
    Dim S
    Dim AddedFiles As Boolean

    If Right(StartFolder, 1) <> "\" Then StartFolder = StartFolder & "\"
    If AddToArrayAt < 0 Then AddToArrayAt = LBound(arrFiles)

    f = Dir(StartFolder & Pattern)
    Do While Len(f) > 0
        AddedFiles = True
        If AddToArrayAt > UBound(arrFiles) Then ReDim Preserve arrFiles(LBound(arrFiles) To UBound(arrFiles) + 100)
        arrFiles(AddToArrayAt) = StartFolder & f
        AddToArrayAt = AddToArrayAt + 1
        f = Dir()
    Loop
    If AddedFiles Then ReDim Preserve arrFiles(LBound(arrFiles) To AddToArrayAt - 1)

    Set subF = New Collection
    sf = Dir(StartFolder, vbDirectory)
    Do While Len(sf) > 0
        If sf <> "." And sf <> ".." Then
            If (GetAttr(StartFolder & sf) And vbDirectory) <> 0 Then
                subF.Add StartFolder & sf
            End If
        End If
        sf = Dir()
    Loop

    For Each S In subF
        GetAllFilePaths CStr(S), Pattern, arrFiles, AddToArrayAt
    Next S

End Sub

Sub test()
    Dim pdfFileNames() As String

    ReDim pdfFileNames(1 To 100)
    GetAllFilePaths "C:\Data\", "*.PDF", pdfFileNames

    Dim i As Long
    For i = LBound(pdfFileNames) To UBound(pdfFileNames)
        Debug.Print pdfFileNames(i)
    Next

End Sub

Несколько замечаний:

• Я Redim Preserve использую массив arrFiles сотнями, потому что эта операция довольно медленная
• Я сохранил коллекцию внутренне для цикла папок, так как он довольно удобен и не подвержен процедуре вызова
• Я не изучал ваши Dir, поэтому я не претендую на их эффективность или эффективность