フォルダとサブフレージャのワークブック内のワークシートをループする

Question

おはなしの協力者。 私は同様の質問をしましたが、、この1つはねじれがあります...私は、すべてのサブフォルダと最初に選択したフォルダによってコード検索を行い、形式コードを実行したい

を

コードは魅力的ですが、最初のプロンプトで選択したルートフォルダでのみ動作します。

私は別のものを追加したと思った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 

Answer 1

は、再帰的プログラミングを使用して、すべてのすべてのフォルダ内のファイル、およびサブフォルダを一覧表示する方法です。

'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 

ファイルをリストし、リストの要素（ファイルのパスと名前）をループすることをお勧めします。各ファイルをループした後、各フォルダで任意の操作を実行して開きます。作業が完了したら、すべての変更を保存して各ファイルを閉じます。追加の質問がある場合は、後で返信してください。