Excel VBA: Loop Through All Files in a Folder

The Basic Dir Loop

Option Explicit

Sub ProcessFolder()
    Dim folder As String, f As String, wb As Workbook

    folder = "C:\Reports\Branches\"
    If Right$(folder, 1) <> "\" Then folder = folder & "\"

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    On Error GoTo CleanUp

    f = Dir(folder & "*.xls*")
    Do While Len(f) > 0
        If Left$(f, 2) <> "~$" Then                      ' skip lock files
            Set wb = Workbooks.Open(folder & f, ReadOnly:=True, UpdateLinks:=0)
            ' --- do the work here ---
            Debug.Print f, wb.Worksheets(1).Range("B2").Value
            wb.Close SaveChanges:=False
        End If
        f = Dir()                                        ' next file
    Loop

CleanUp:
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    If Err.Number <> 0 Then MsgBox "Stopped at " & f & ": " & Err.Description
End Sub

Let the User Pick the Folder

Function PickFolder() As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Choose the folder to process"
        If .Show = -1 Then PickFolder = .SelectedItems(1) & "\"
    End With
End Function

Combine Data From Every File Into One Sheet

Sub CombineBranchFiles()
    Dim folder As String, f As String, wb As Workbook
    Dim src As Worksheet, dest As Worksheet, data As Variant
    Dim lastRow As Long, nextRow As Long

    folder = PickFolder(): If Len(folder) = 0 Then Exit Sub
    Set dest = ThisWorkbook.Worksheets("Combined")
    dest.Cells.ClearContents
    dest.Range("A1:F1").Value = Array("Source", "Date", "Customer", "Product", "Qty", "Amount")
    nextRow = 2

    Application.ScreenUpdating = False
    f = Dir(folder & "*.xlsx")
    Do While Len(f) > 0
        If Left$(f, 2) <> "~$" Then
            Set wb = Workbooks.Open(folder & f, ReadOnly:=True)
            Set src = wb.Worksheets("Sales")
            lastRow = src.Cells(src.Rows.Count, "A").End(xlUp).Row
            If lastRow >= 2 Then
                data = src.Range("A2:E" & lastRow).Value          ' read once into an array
                dest.Cells(nextRow, 2).Resize(UBound(data), 5).Value = data
                dest.Cells(nextRow, 1).Resize(UBound(data), 1).Value = f
                nextRow = nextRow + UBound(data)
            End If
            wb.Close False
        End If
        f = Dir()
    Loop
    Application.ScreenUpdating = True
    MsgBox nextRow - 2 & " rows combined.", vbInformation
End Sub

Include Subfolders With FileSystemObject

Sub ProcessTree(ByVal folderPath As String)
    Dim fso As Object, fld As Object, sub_ As Object, fil As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fld = fso.GetFolder(folderPath)

    For Each fil In fld.Files
        If LCase$(fso.GetExtensionName(fil.Name)) Like "xls*" _
           And Left$(fil.Name, 2) <> "~$" Then
            ProcessOneFile fil.Path                     ' your per-file routine
        End If
    Next fil

    For Each sub_ In fld.SubFolders
        ProcessTree sub_.Path                           ' recurse
    Next sub_
End Sub

Common Tasks Inside the Loop

Pitfalls

• Nested Dir calls reset the outer loop. Collect names first if you need Dir inside the loop.

• Files open in another user's Excel can be opened read-only only; check wb.ReadOnly before saving.

• Sheet names differ between files: test with a function that checks the sheet exists.

• Workbooks with Workbook_Open macros run them when opened; EnableEvents = False prevents that.

• Very large folders: log progress to the status bar and a log sheet so you know where it stopped.

VBA Loop or Power Query?