0

So I have been trying to create a bit of code that can loop through and entire directory starting at a specific folder. I need this to dig down and grab every folder that has files in it and place that folder in an array for later functions that will grab specifically named files out of those folders. I am struggling on where to store the parent file in this loop so I can return to that file after digging down into the previous folder's subfolders. I have tried For Each loops, but I struggle to keep the loop going after I go through the first folders. I end up using a For Each on the subfolders of the initial subfolders of the first loop and I cannot seem to make up a good way to change the first folder to dig deeper into the folders. I then tried a Do While loop, but then I just get infinity loops and Excel crashes.

Dim fso As New FileSystemObject
Dim trgtMchnFldr As Object
Dim fldr As Object
Dim sbFldr As Object
Dim BOMFl As Object
Dim chngOvrFl As Object
Dim mchnSpecFl As Object

Dim flToFindName() As Variant
Dim flName As Variant
Dim mchnSubFldrArr() As Variant

Set trgtMchnFldr = mchnFldr(Range("A1"))
If trgtMchnFldr Is Nothing Then
    MsgBox "This machine does not exist."
    Exit Sub
End If
ittrCnt = 0
For Each fldr In trgtMchnFldr.SubFolders
    If fldr.Name <> "P1-Inquiry_Proposal" Then
        If fldrFndr(mchnSubFldrArr(), fldr) = False Then
            If fldr.Files.Count > 0 Then
                If ittrCnt = 0 Then
                    ReDim Preserve mchnSubFldrArr(0)
                    Set mchnSubFldrArr(0) = fldr
                    ittrCnt = ittrCnt + 1
                Else
                    ReDim Preserve mchnSubFldrArr(UBound(mchnSubFldrArr) + 1)
                    Set mchnSubFldrArr(UBound(mchnSubFldrArr)) = fldr
                End If
            End If
        End If
        If fldrFndr(mchnSubFldrArr(), fldr) = False Then
            Set trgtMchnFldr = fldr
        End If
        For Each sbFldr In fldr.SubFolders
            If fldrFndr(mchnSubFldrArr(), sbFldr) = False Then
                If sbFldr.Files.Count > 0 Then
                    If ittrCnt = 0 Then
                         ReDim Preserve mchnSubFldrArr(0)
                        Set mchnSubFldrArr(0) = fldr
                        ittrCnt = ittrCnt + 1
                    Else
                        ReDim Preserve mchnSubFldrArr(UBound(mchnSubFldrArr) + 1)
                        Set mchnSubFldrArr(UBound(mchnSubFldrArr)) = sbFldr
                    End If
                End If
            End If
        Next sbFldr
    Else
        GoTo skpFldr:
    End If
skpFldr:
Next fldr

This is the For Each loop which functions and gets me mostly what I want, but still fails to dig down. There is code after this, but that code is fully functioning.

Dim fldr As Variant
On Error GoTo fldrEmpty:
For Each fldr In fldrArr
    If fldrQstn = fldr Then
        fldrFndr = True
        Exit Function
    End If
Next fldr
fldrEmpty:
isFldrFnd = False
End Function

This is my folder finder function that I use to test if a specific folder has already been placed in my array to prevent duplicates. If you have suggestions on how to clean this up feel free to suggest it.

0 Answers0