Open file within multiple subfolders and loop

[brad999]

Evening,

I have the following code which opens a file, within a subfolder of the activeworkbookpath, with the filename stored in cell A70. However, the file could be stored within 1 subfolder, or within multiple subfolders, so I need the code to look through all subfolders of the activeworkbookpath.

Also, ideally, it would be great if a loop could be in place that would open the filename at A70, extract the relevant information, then open the filename at A71 and extract relevant information and repeat until cell A# is blank.

Is this possible?? Thanks in advance!!

Dim simWbk As Excel.Workbook
Dim simSht As Worksheet


Set simWbk = ActiveWorkbook
Set simSht = ActiveSheet






Dim strFilePath As String
Dim strFileName As String
Dim objFolder As Object


strFilePath = ActiveWorkbook.Path & "\"
strFileName = strFilePath & Sheets("Temp_Data").Range("A70")


For Each objFolder In CreateObject("Scripting.FileSystemObject"). _
        GetFolder(strFilePath).SubFolders
  If Len(Dir(objFolder.Path & "\" & Sheets("Temp_Data").Range("A70"))) > 0 Then
    With Workbooks.Open(objFolder.Path & "\" & Sheets("Temp_Data").Range("A70"))
      .Sheets(1).Range("A1:W59").Copy
      ThisWorkbook.Sheets("Temp_Data").Range("A1").PasteSpecial xlPasteValues
      ThisWorkbook.Sheets("Temp_Data").Range("A64").Value = .BuiltinDocumentProperties("Last Author").Value
      Application.DisplayAlerts = False
      .Close False
    End With
    Sheets("Temp_Data").Range("A63").Value = Mid$(strFileName, InStrRev(strFileName, "\") + 1)
  End If
Next objFolder
Application.ScreenUpdating = True

 

[FDibbins]

cross-posted here...
Open file within subfolders and loop