循环遍历文件夹和子文件夹中工作簿中的工作表

Posted 2021-04-17

美好的一天合作者。我问了一个类似的问题，但是，这个问题有一个转折点：

我想让代码搜索所有子文件夹和最初选择的文件夹并运行格式代码...

代码的工作方式类似于魅力，但仅适用于在初始提示中选择的根文件夹。

我想如果我添加了另一个Do While，但它没有奏效。

这是当前的工作代码（没有子文件夹）：

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

答案

这是一种使用递归编程列出所有文件夹和子文件夹中的所有文件的方法。

'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

我建议你列出文件，然后循环遍历列表的元素（文件路径和名称）。在循环浏览每个文件后，在每个文件夹中执行所需的任何操作，然后将其打开。完成工作后，保存所有更改并关闭每个文件。如果您还有其他问题，请回复。