Which is the best approach if any for selective looping through the directories in excel vba

Question

IO want to check all the edf files at the path main directory/ABC*/Y/XY*/*.edf and then check the files for a specific phrase and if found check for another phrase and so on and then fill the data in the spreadsheet. I have tried to achieve this through three methods but was stuck at some point in every method. Is it possible for anyone of you to go through the code and tell me where I am wrong and which the best approach if any. As the misconception created by my previous questions I don't want anyone to write code for me. I've started working on vba for three days and I've 5 days to complete this project. That's why I'd be grateful if anyone could have a look and tell me where I'm going wrong.

Approach 1 through simple directory command In this First loop for FCS* is working great but then the second loop doesn't work at all and gives run-time error at the first iteration. I know this is not a good approach but in case any other doesn't work.

 Sub Iterate_Folders()
        Dim ctr As Integer
        Dim ctr1 As Integer
        ctr = 1
        ctr1 = 1
        Paths = "C:\Users\sobiakanwal\Downloads\QSHWRA\QSHWRA\ "   ' Path should always contain a '\' at end
        FirstDir = Dir(Paths, vbDirectory)   ' Retrieving the first entry.
        Do Until FirstDir = ""   ' Start the loop.
            If (FirstDir Like "FCS*") Then
                ActiveSheet.Cells(ctr, 15).Value = Paths & FirstDir
                Path1 = Paths & FirstDir & "\FUNCTION_BLOCK\DR*"
                ActiveSheet.Cells(ctr, 20).Value = Path1
                'ActiveSheet.Cells(ctr, 25).Value = SecondDir
                SecondDir = Dir(Path1, vbDirectory)
                Do While SecondDir = ""
                    ActiveSheet.Cells(ctr, 30).Value = "Hi"
                    If (True) Then
                        ctr1 = ctr1 + 1
                    End If
                    SecondDir = Dir()
                Loop
                ctr = ctr + 1
            Else

            End If
            FirstDir = Dir()   ' Getting next entry.
        Loop
        MsgBox (ctr1)
    End Sub

Approach 2 through Recursion I found the basic code for this in a tutorial and then edited it somewhat to my advantage. This doesn't work generically but gives the right answer in somewhat hard-coded manner. But I want you to check just the point where I'm stuck in the recursion function where I need to add the file handling code.

Public temp() As String
Public Count As Integer
Function ListFiles(FolderPath As String)

    Dim myFile As String, text As String, textline As String, posLat As Integer, posLong As Integer
    Dim k As Long, i As Long
    ReDim temp(2, 0)
    Count = 1
    If Right(FolderPath, 1) <> "\" Then
        FolderPath = FolderPath & "\"
    End If
    Recursive FolderPath
    k = Range(Application.Caller.Address).Rows.Count
    If k < UBound(temp, 2) Then
        MsgBox "There are more rows, extend user defined function"
    Else
        For i = UBound(temp, 2) To k
              ReDim Preserve temp(UBound(temp, 1), i)
                temp(0, i) = ""
                temp(1, i) = ""
                temp(2, i) = ""
        Next i
    End If
    ListFiles = Application.Transpose(temp)
    ReDim temp(0)

End Function



Function Recursive(FolderPath As String)

    Dim strFilename As String
    Dim strFileContent As String
    Dim iFile As Integer
    Dim fileName As String, textData As String, textRow As String, fileNo As Integer
    Dim Value As String, Folders() As String
    Dim Folder As Variant, a As Long
    Dim Right_FolderPath As String
    ReDim Folders(0)
    If Right(FolderPath, 2) = "\\" Then Exit Function
    Value = Dir(FolderPath, &H10)
    Do Until Value = ""
        If Value = "." Or Value = ".." Then
        Else
            If GetAttr(FolderPath & Value) = 16 Then
                Folders(UBound(Folders)) = Value
                ReDim Preserve Folders(UBound(Folders) + 1)
            Else
                If Right(Value, 4) = ".edf" Then
                If Count = 4 Then
                    Right_FolderPath = Right(FolderPath, 7)
                    If Left(Right_FolderPath, 2) = "DR" Then
                        strFilename = FolderPath & Value
                        iFile = FreeFile
                        Open strFilename For Input As #iFile
                        strFileContent = Input(LOF(iFile), iFile)
                        Close #iFile

                         If InStr(1, strFileContent, "hihowareyou") <> 0 Then
                            ActiveSheet.Cells(1, 1) = strFilename
                            longLoc = InStr(1, strFileContent, "Longitude:")
                            If longLoc <> 0 Then
                                 ActiveSheet.Cells(1, 2) = Mid(strFleContent, longLoc + Len("Longitude:"), 10)
                            End If
                        End If

                ''''Here it goes all wrong

                    'myFile = FolderPath & Value
                    'myFile = Application.GetOpenFilename()
                    'fileNo = FreeFile 'Get first free file number
                    'Open fileName For Input As #fileNo
                    'Do While Not EOF(fileNo)
                    '    Line Input #fileNo, textRow
                    '    textData = textData & textRow
                    'Loop
                    'Close #fileNo
                    'posLat = InStr(text, "ff-ai")
                    'If Not posLat = vbNullString Then
                    '    temp(0, UBound(temp, 2)) = Value
                    'End If
                        temp(0, UBound(temp, 2)) = FolderPath
                        temp(1, UBound(temp, 2)) = Value
                        temp(2, UBound(temp, 2)) = Count ' FileLen(FolderPath & Value)
                        ReDim Preserve temp(UBound(temp, 1), UBound(temp, 2) + 1)
                    End If
                End If
            End If
            End If
        End If
        Value = Dir
    Loop

    For Each Folder In Folders
        Count = Count + 1
        Recursive FolderPath & Folder & "\"
        Count = Count - 1
    Next Folder

End Function

The Third Approach By Dictionary Object This was suggested by someone on Stock Overflow and worked right for him but not for me. I don't know vba enough to debug it.

Sub build_FolderLevels(dFMs As Scripting.Dictionary, _
                   Optional sFM As String = "", _
                   Optional iFLDR As Long = 0)
Dim d As Long, fp As String, vFMs As Variant

If CBool(dFMs.Count) Then
    vFMs = dFMs.Keys
    For d = LBound(vFMs) To UBound(vFMs)
        vFMs(d) = vFMs(d)
    Next d
Else
    vFMs = Array(sFM)
End If
dFMs.RemoveAll

For d = LBound(vFMs) To UBound(vFMs)
    fp = Dir(vFMs(d), iFLDR)
    Do While CBool(Len(fp))
        dFMs.Add Key:=Left(vFMs(d), InStrRev(vFMs(d), Chr(92))) & fp, _
                 Item:=iFLDR
        fp = Dir
    Loop
Next d

End Sub

Sub main()

Dim fm As Long, sFM As String, vFMs As Variant, sMASK As String
Dim fn As Variant, dFNs As New Scripting.Dictionary

sFM = Environ("TMP") & "\QSHWRA\FCS*\FUNCTION_BLOCK\DR*\*.edf"
If UBound(Split(sFM, Chr(42))) < 2 Then Exit Sub  '<~~possibly adjust this safety
sFM = Replace(sFM, "/", "\")
vFMs = Split(sFM, Chr(92))

sMASK = vFMs(LBound(vFMs))
For fm = LBound(vFMs) + 1 To UBound(vFMs)
    sMASK = Join(Array(sMASK, vFMs(fm)), Chr(92))
    If CBool(InStr(1, vFMs(fm), Chr(42))) Or fm = UBound(vFMs) Then
        build_FolderLevels dFNs, sFM:=sMASK, iFLDR:=Abs((fm < UBound(vFMs)) * vbDirectory)
        sMASK = vbNullString
    End If
Next fm

'list the files
For Each fn In dFNs
    Debug.Print "from dict: " & fn
Next fn

dFNs.RemoveAll: Set dFNs = Nothing
End Sub

Answer 1

I would suggest you go through all the subfolders below main directory, and just collect the files that meet your criteria. I'd probably use the WindowsShell with something like Dir MainFolder\*.edf /B /S (bare format and recursion switches set) and just save or collect those files that are in desired subfolders. But you could also do something similar with DIR or the FileSystemObject and recursion.