Find Windows subfolders with specified name

Question

I want to loop through a folder (G:/Proj) and find any subfolders named "SUMMARY LOG" and then print the Excel files, usually just one, within each of those folders.

This is the main folder (Proj) with all of the project folders within it

This is a screenshot of just one of the files I want to print out.

Each project has a SUMMARY LOG folder.

Here is the VBA code. It loops through every sub folder and prints out every Excel file in those folders not just the "SUMMARY LOG".

Sub LoopFolders()
    Dim strFolder As String
    Dim strSubFolder As String
    Dim strFile As String
    Dim colSubFolders As New Collection
    Dim varItem As Variant
    Dim wbk As Workbook
    ' Parent folder including trailing backslash
    strFolder = "G:/Proj/"
    ' Loop through the subfolders and fill Collection object
    strSubFolder = Dir(strFolder & "*", vbDirectory)
    Do While Not strSubFolder = ""
        Select Case strSubFolder
            Case ".", ".."
                ' Current folder or parent folder - ignore

            Case Else
                ' Add to collection
                colSubFolders.Add Item:=strSubFolder, Key:=strSubFolder
        End Select
        ' On to the next one
        strSubFolder = Dir
    Loop
    ' Loop through the collection
    For Each varItem In colSubFolders
        ' Loop through Excel workbooks in subfolder
        strFile = Dir(strFolder & varItem & "\*.xls*")
        Do While strFile <> ""
            ' Open workbook
            Set wbk = Workbooks.Open(Filename:=strFolder & _
                varItem & "\" & strFile, AddToMRU:=False)
            ' Do something with the workbook
            ActiveSheet.PrintOut
            ' Close it
            wbk.Close SaveChanges:=False
            strFile = Dir
        Loop
    Next varItem
End Sub

Answer 1

This is how I changed your code (please note that you should set your "objects" to nothing at the end of your code).

Note that I just used a simple "If" statement with the "InStr" function to try and catch the buzzwords associated with your excel workbooks. Here is what my simulated folder looked like: Simulated Folder with File Names

Sub LoopFolders()
Dim strFolder As String
Dim strSubFolder As String
Dim strFile As String
Dim colSubFolders As New Collection
Dim varItem As Variant
Dim wbk As Workbook
' Parent folder including trailing backslash
strFolder = "C:\Users\anm2mip\Desktop\Exp\"
' Loop through the subfolders and fill Collection object
strSubFolder = Dir(strFolder & "*", vbDirectory)
Do While Not strSubFolder = ""
    Select Case strSubFolder
        Case ".", ".."
        ' Current folder or parent folder - ignore

        Case Else
            ' Add to collection
            colSubFolders.Add Item:=strSubFolder, Key:=strSubFolder
    End Select
    ' On to the next one
    strSubFolder = Dir
Loop
' Loop through the collection
For Each varItem In colSubFolders
    ' Loop through Excel workbooks in subfolder
    strFile = Dir(strFolder & varItem & "\*.xls*") 'never mind the .xlsx, I forgot that the * symbol is wildcard.
    Do While strFile <> ""
         If InStr(strFile, "Summary") And InStr(strFile, "Log") Then
             ' Open workbook
             Set wbk = Workbooks.Open(FileName:=strFolder & _
             varItem & "\" & strFile, AddToMRU:=False)
             ' Do something with the workbook
             MsgBox strFile
             ' ActiveSheet.PrintOut
             ' Close it
             wbk.Close SaveChanges:=False
         End If
         strFile = Dir
      Loop
Next varItem

Set colSubFolders = Nothing
Set varItem = Nothing
Set wbk = Nothing
End Sub

UPDATE

Test Folder Structure Note that I threw a couple different excel file types and a word document in there as well, and my code below filters out all except the excel file types that I've specified.

I used this answer as a reference: Recursive drill down into folders example. Thank you user @Cor_Blimey for the easy-to-use post.

Sub LoopFolders()
Dim fso, oFolder, oSubfolder, oFile, queue As Collection
Dim colFiles As New Collection
Dim wbk As Workbook

Set fso = CreateObject("Scripting.FileSystemObject")
Set queue = New Collection
queue.Add fso.GetFolder("C:\Users\anm2mip\Desktop\Exp\")

' Parent folder including trailing backslash
'strFolder = "C:\Users\anm2mip\Desktop\Exp\"

Do While queue.Count > 0
    Set oFolder = queue(1)
    queue.Remove 1 'dequeue
    For Each oSubfolder In oFolder.SubFolders
        queue.Add oSubfolder
    Next oSubfolder
    'Filter subfolders here
    If InStr(oFolder.Name, "Summary") And InStr(oFolder.Name, "Log") Then
        For Each oFile In oFolder.Files
            'You can filter files here with an if...then statement
            If oFile.Type = "Microsoft Excel Worksheet" Or _
            oFile.Type = "Microsoft Excel 97-2003 Worksheet" Or _
            oFile.Type = "Microsoft Excel Macro-Enabled Worksheet" Then
                colFiles.Add Item:=oFile, Key:=oFile.Name
        Next oFile
    End If
Loop

MsgBox "Number of files held in Summary Log folders is: " & colFiles.Count
For Each oFile In colFiles
    Set wbk = Workbooks.Open(FileName:=oFile.Path, AddtoMRU:=False)
    MsgBox oFile.Name
    'Do your printing operation here.
    wbk.Close SaveChanges:=False
Next oFile

Set fso = Nothing
Set oFolder = Nothing
Set oSubfolder = Nothing
Set oFile = Nothing
Set queue = Nothing
Set wbk = Nothing
End Sub