Loop through worksheets in workbooks in a folder and subforlders

Question

Good day collaborators. I have asked a similar question, but, this one has a twist:

I want to make the code search through all sub-folders and the initially selected folder and run the format code...

The code works like a charm, but only works in the root folder that was selected in the initial prompt.

I thought that if I added another Do While, but it hasn't worked.

Here is the current working code (no sub-folders):

Sub DarFormatoExelsEnFolder()
 Dim wb As Workbook
 Dim myPath As String
 Dim myFile As String
 Dim myExtension As String
 Dim FldrPicker As FileDialog

'Optimizar Macro
 Application.ScreenUpdating = False
 Application.EnableEvents = False
 Application.Calculation = xlCalculationManual

'Definir carpeta destino
 Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

 With FldrPicker
  .Title = "Select A Target Folder"
  .AllowMultiSelect = False
    If .Show <> -1 Then GoTo NextCode
    myPath = .SelectedItems(1) & "\"
 End With

NextCode:
 myPath = myPath
If myPath = "" Then GoTo ResetSettings

myExtension = "*.xlsx*"
myFile = Dir(myPath & myExtension)

Do While myFile <> ""
'Variable de libro abierto
  Set wb = Workbooks.Open(Filename:=myPath & myFile)
'Confirmación de libro abierto
  DoEvents

'Cambios al Workbook

Format wb

'Guardar y cerrar Workbook actual
  wb.Close SaveChanges:=True

'Confirmación de libro cerrado
  DoEvents

'Proximo libro
  myFile = Dir
 Loop

'Aviso de fin de ejecución
 MsgBox "Operación Completada"

ResetSettings:
'Normalizar excel
 Application.EnableEvents = True
 Application.Calculation = xlCalculationAutomatic
 Application.ScreenUpdating = True

End Sub
'_______________________________________________________

Sub Format(wb As Workbook)
Dim i As Integer
Dim ws_num As Integer

Dim starting_ws As Worksheet
Set starting_ws = ActiveSheet 'remember which worksheet is active in the beginning
ws_num = ActiveWorkbook.Worksheets.Count

For i = 1 To ws_num
    ActiveWorkbook.Worksheets(i).Activate

If Range("C1") <> "Company Name" Then

 'Sheet format start

  Cells.Select
    Cells.EntireColumn.AutoFit
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Font.Bold = True

    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 15773696
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    Rows("1:5").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
    End With
    'Pega o Llena información y logo predeterminados
    Workbooks("REPORTE.xlsm").Worksheets("BACKEND").Range("F3:F3").Copy Destination:=Range("C1")
        Workbooks("REPORTE.xlsm").Worksheets("BACKEND").Range("F4:F4").Copy Destination:=Range("C2")
            Workbooks("REPORTE.xlsm").Worksheets("BACKEND").Range("F5:F5").Copy Destination:=Range("C3")
                Workbooks("REPORTE.xlsm").Worksheets("BACKEND").Range("LogoBR").Copy Destination:=Range("A1")
    Range("C4").Select
    ActiveCell.FormulaR1C1 = ActiveSheet.Name & " - Actualizado el: " & ActiveWorkbook.BuiltinDocumentProperties("Last Save Time")
    Range("C1:C4").Select
    Range("C4").Activate
    Selection.Font.Bold = True
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With

End If
    'Sheet format end

Range("A1").Select
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
'Numera las hojas
    ActiveWorkbook.Worksheets(i).Cells(1, 1) = 1
Next
'reactiva hoja inicial
starting_ws.Activate

End Sub

Search how to access all sub-directories in a directory using `FileSystemObject`. This link might give you some help on where to start: https://stackoverflow.com/questions/22645347/loop-through-all-subfolders-using-vba — Brownish Monster, Dec 21 '17 at 14:43
What you're asking for will require recursion (a function that calls itself) in order to search through each subfolder (and subfolders of those, and subfolders of those, etc). The link provided by Brownish Monster demonstrates this. — tigeravatar, Dec 21 '17 at 19:24

score 0 · Answer 1 · answered Dec 23 '17 at 19:36

Here is a way to list all files in all folders, and sub-folders, using recursive programming.

'Looping Through Folders and Files in VBA
Public ObjFolder As Object

Public objFso As Object
Public objFldLoop As Object
Public lngCounter As Long
Public objFl As Object


'===================================================================
'A procedure to call the Function  LoopThroughEachFolder(objFolder)
'===================================================================

Sub GetFolderStructure()
'
    lngCounter = 0
    Set objFso = CreateObject("Scripting.FileSystemObject")
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Show
        Set ObjFolder = objFso.GetFolder(.SelectedItems(1))
    End With
    Range("A1").Offset(lngCounter).Value = ObjFolder.Path
    LoopThroughEachFolder ObjFolder

End Sub
'===================================================
'Function to Loop through each Sub Folders
'===================================================

Function LoopThroughEachFolder(fldFolder As Object)

    For Each objFldLoop In fldFolder.subFolders
    lngCounter = lngCounter + 1
    Range("A1").Offset(lngCounter).Value = objFldLoop.Path
    LoopThroughEachFolder objFldLoop
    Next

End Function

I would suggest you list the files, and then loop through the elements of the list (the file paths and names). Perform any operation you want, after you loop through each file, in each folder, and open it. After your work is done, save all changes and close each file. Post back if you have additional questions.

Loop through worksheets in workbooks in a folder and subforlders

1 Answers1