Open All Excel Workbooks in Many Folders One by One

The workbook and code below opens all excel workbooks in many folders one-by-one to pull data from them one-by-one so that you can auto-pull hundreds of files without even looking and stack information daily from hundreds of excel files in hundreds of different folders.

Code:

Sub FolderAndFileMacro()

Dim mypath As String
Dim myfile As String
Dim myfile2
Dim myextension As String
Dim wb As Workbook
Dim FldrPicker As FileDialog


Dim xx As Double

 Dim oFSO As Object
 Dim folder As Object
 Dim subfolders As Object
 
 Set oFSO = CreateObject("Scripting.FileSystemObject")
 Set folder = oFSO.GetFolder("C:\Users\18622\OneDrive\Desktop\New folder\")
 Set subfolders = folder.subfolders
 xx = subfolders.count
 
 Set oFSO = Nothing
 Set folder = Nothing
 Set subfolders = Nothing
 'release memory

Dim x As Double

x = 1

Do Until x > xx






mypath = "C:\Users\18622\OneDrive\Desktop\New folder\" & x & "\"

'pull file names from Module 2 called GrabFilenamesfromFolder. It pulls the file names from the folder you select and set to mypath variable.
GrabFilenamesfromFolder (mypath)


erow = Range("A" & Rows.count).End(xlUp).Row
Range("B1").Select
ActiveCell.FormulaR1C1 = "=SEARCH("".xl"",RC[-1],1)"
Range("B1").Select
Selection.AutoFill Destination:=Range("B1" & ":" & "B" & erow), Type:=xlFillDefault
Columns("B").Select
Selection.Copy
Columns("B").Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=False
 Columns("B").Select

 Selection.Replace What:="#VALUE!", Replacement:="0", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
Dim counter As Double
counter = 1
      


'Target File Extension (must include wildcard "*")


'Loop through each Excel file in folder
Do Until counter > erow
line15:
If Range("B" & counter).Value <> 0 Then
myfile2 = Range("A" & counter).Value
counter = counter + 1
GoTo line11:
End If
counter = counter + 1
Loop
line11:
'Set variable equal to opened workbook

      Set wb = Workbooks.Open(Filename:=mypath & myfile2)
      
 'add actions to do to this workbook
      
'switch back to workbook that has this macro
Workbooks("Open all workbooks in each folder.xlsm").Activate
'close myfile
Workbooks(myfile2).Close False
If counter <= erow Then
GoTo line15:
End If

Workbooks("Open all workbooks in each folder.xlsm").Activate
Columns("A:B").Select
Selection.ClearContents
x = x + 1
Loop

End Sub

Sub GrabFilenamesfromFolder(path As String)
    Dim currentPath As String, directory As Variant
    Dim dirCollection As Collection
    Set dirCollection = New Collection
    Dim counter As Double
    counter = 1
    currentPath = Dir(path, vbDirectory)
    
    'Explore current directory
    Do Until currentPath = vbNullString
        Debug.Print currentPath
        'If Left(currentPath, 1) <> "." And _
            '(GetAttr(path & currentPath) And vbDirectory) = vbDirectory Then
            dirCollection.Add currentPath
        'End If
        currentPath = Dir()
        Range("A" & counter).Value = currentPath
        counter = counter + 1
    Loop
    
   
End Sub