Find Windows subfolders with specified name - vba

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