Loop through files in a given folder, check cell content in CLOSED files to identify template and add said files to array

Question

I'm mainly trying to work off of the solution in this thread How to loop through all sheets in all workbooks within a folder.

This is the code responsible for filling the array

    'Fill the array(myFiles)with the list of Excel files in the folder
    Fnum = 0
    Do While FilesInPath <> ""
        Fnum = Fnum + 1
        ReDim Preserve MyFiles(1 To Fnum)
        MyFiles(Fnum) = FilesInPath
        FilesInPath = Dir()
    Loop

If I understand it correctly, it should loop through all files in a given folder and retrieve every excel file in it.

Based on this thread ExecuteExcel4Macro to get value from closed workbook ExecuteExcel4Macro(string) should allow to check/retrieve the content of a given cell in a closed workbook of which I already have its name and its sheet's name.

I want to check the value of a cell (so I can identify whether the file is based on a template which I would like to work on) so it gets added to the array in the first.

I would like to integrate the solution to check cell content into the loop I pasted above.

Option Explicit

Sub Sample()
    Dim wbPath As String, wbName As String
    Dim wsName As String, cellRef As String
    Dim Ret As String

    'wbPath = "C:\Documents and Settings\Siddharth Rout\Desktop\"
    wbPath = "C:\Users\my.name\Desktop\"

    wbName = "QOS DGL stuff.xls"
    wsName = "ACL"
    cellRef = "C3"

    Ret = "'" & wbPath & "[" & wbName & "]" & _
          wsName & "'!" & Range(cellRef).Address(True, True, -4150)

    MsgBox ExecuteExcel4Macro(Ret)
End Sub

Answer 1

Check Cell in Closed Files (ExecuteExcel4Macro)

Option Explicit

Sub ProcessFiles()

    Dim sFolderPath As String
    sFolderPath = Environ("USERPROFILE") & "\OneDrive\Documents\Test\"
    Const sExtensionPattern As String = "*.xls*"
    Const swsName As String = "ACL"
    Const sCellAddress As String = "C3"
    Const sString As String = "Yes"

    Dim sFileName As String: sFileName = Dir(sFolderPath & sExtensionPattern)

    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare

    Dim cString As String

    Do While Len(sFileName) > 0
        cString = GetCellString(sFolderPath, sFileName, swsName, sCellAddress)
        If StrComp(cString, sString, vbTextCompare) = 0 Then
            ' You could process the files here without writing them
            ' to a data structure...
            dict(sFolderPath & sFileName) = Empty
        End If
        sFileName = Dir
    Loop

    If dict.Count = 0 Then Exit Sub

    Debug.Print Join(dict.Keys, vbLf)

'    ' ... or loop through the dictionary ...
'    Dim Key As Variant
'    For Each Key In dict.Keys
'        ' Continue
'        'Debug.Print Key
'
'    Next Key
'
'    ' ... or write the values from the dictionary to an array
'    ' and loop through the array.
'    Dim MyFiles As Variant: MyFiles = dict.Keys
'
'    Dim n As Long
'
'    For n = 0 To UBound(MyFiles)
'        ' Continue
'        'Debug.Print MyFiles(n)
'    Next n

End Sub

Function GetCellString( _
    ByVal wbPath As String, _
    ByVal wbName As String, _
    ByVal wsName As String, _
    ByVal CellAddress As String) _
As String
    Const ProcName As String = "GetCellString"
    On Error GoTo ClearError

    Dim ee4mString As String
    ee4mString = "'" & wbPath & "[" & wbName & "]" & _
          wsName & "'!" & Range(CellAddress).Address(ReferenceStyle:=xlR1C1)

    GetCellString = ExecuteExcel4Macro(ee4mString)

ProcExit:
    Exit Function
ClearError:
    Debug.Print "'" & ProcName & "': Unexpected Error!" & vbLf _
              & "    " & "Run-time error '" & Err.Number & "':" & vbLf _
              & "    " & Err.Description
    Resume ProcExit
End Function