Need to modify my VBA code to include subfolders as well

Question

I have created a VBA code that loops through all excel workbooks in a given folder , opens then, refreshes the sheet, pauses for 10 seconds, closes and saves and moves on to the next. The issue I am facing is that it wont do it for the excel workbooks in the subfolder, Please can someone assist.

The code is as per below:

Sub LoopAllExcelFilesInFolder()
'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them
'SOURCE: www.TheSpreadsheetGuru.com

Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog

'Optimize Macro Speed
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual

'Retrieve Target Folder Path From User
  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

'In Case of Cancel
NextCode:
  myPath = myPath
  If myPath = "" Then GoTo ResetSettings

'Target File Extension (must include wildcard "*")
  myExtension = "*.xls*"

'Target Path with Ending Extention
  myFile = Dir(myPath & myExtension)

'Loop through each Excel file in folder
  Do While myFile <> ""
    'Set variable equal to opened workbook
      Set wb = Workbooks.Open(Filename:=myPath & myFile)

    'Ensure Workbook has opened before moving on to next line of code
      DoEvents

    'Change First Worksheet's Background Fill Blue
      Application.Calculate
      ActiveWorkbook.RefreshAll
  Application.Wait (Now + TimeValue("0:00:10"))

    'Save and Close Workbook
      wb.Close SaveChanges:=True

    'Ensure Workbook has closed before moving on to next line of code
      DoEvents

    'Get next file name
      myFile = Dir
  Loop

'Message Box when tasks are completed
  MsgBox "Task Complete!"

ResetSettings:
  'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub

score 1 · Answer 1 · answered Mar 23 '17 at 09:35

1

Its probably an old question indeed, but still, I enjoyed writing it somehow. And in my solution, you get some nice printing in the console. Here you go:

Option Explicit

Function GetFiles(ByVal Folder As String) As Collection

    Dim strFile As String

    Set GetFiles = New Collection
    strFile = Dir(Folder & "\*")

    Do While strFile <> ""
        GetFiles.Add strFile
        strFile = Dir
    Loop

End Function

Function GetFolders(ByVal Folder As String) As Collection

    Dim strFile As String
    Set GetFolders = New Collection

    strFile = Dir(Folder & "\*", vbDirectory)

    Do While strFile <> ""
        If GetAttr(Folder & "\" & strFile) And vbDirectory Then GetFolders.Add strFile
        strFile = Dir
    Loop

End Function

Sub LoopThroughSubfoldersAsWell()

    Dim colFoFi     As Collection
    Dim varEl01     As Variant
    Dim varEl02     As Variant
    Dim varEl03     As Variant
    Dim strLine     As String: strLine = "--------------------------"

    Dim strAddress As String: strAddress = "C:\Users\UserName\Desktop\Testing01\"

    Debug.Print strAddress
    Set colFoFi = GetFiles(strAddress)

    For Each varEl01 In colFoFi
        Debug.Print varEl01
    Next varEl01
    Debug.Print strLine

    Set colFoFi = GetFolders(strAddress)
    For Each varEl01 In colFoFi
        If Len(varEl01) > 2 Then  'to avoid some hidden stuff

            Set varEl02 = GetFiles(strAddress & varEl01)
            Debug.Print (strAddress & varEl01)

            For Each varEl03 In varEl02
                Debug.Print varEl03
            Next varEl03

            Debug.Print strLine

        End If
    Next varEl01

End Sub

answered Mar 23 '17 at 09:35

Vityata

42,633
8
55
100

Hi Vityata, first off, thank you for the code and help....I am not too good when it comes to functions and wanted to know if your code opens all the excel sheets in all the subfolders, saves them and then closes them again? – Jaybreezy Mar 23 '17 at 10:05
Nope. But you can edit it in the part `varEl03`. It can be assigned to `myFile` value in your code and it would do what you want. – Vityata Mar 23 '17 at 10:10
I ran your code that way and it does not do anything,But thank you so much for sharing Vityata, I will spend time taking pieces out and formulating myself. – Jaybreezy Mar 23 '17 at 10:16
@JarrydWard, in my code change `strAddress` to your root folder. Then it would print a report in the immediate window. That's what it does. Immediate window is opened with Ctrl+G. – Vityata Mar 23 '17 at 10:19
awesome, I have done that and it lists the files that are in the folder and subfolder, I need the macro to open each one, save it and then close it, also adding in a 10 second pause between each sheet it opens as above. – Jaybreezy Mar 23 '17 at 10:42
@JarrydWard - from your code take `Set wb = Workbooks.Open(Filename:=myPath & myFile)` and change the `myPath & myFile` to my `varEl03`. – Vityata Mar 23 '17 at 10:50
Sorry to be a hassle over here Vityata, would you mind incorporating it into my code,I feel as if there could be a misunderstanding....my apologies in advance, you are too sweet for helping out. – Jaybreezy Mar 23 '17 at 10:55
thanks a lot, it still just prints the files I have at the bottom, doesnt open and save them., but thank you so much. – Jaybreezy Mar 23 '17 at 11:39

Need to modify my VBA code to include subfolders as well

1 Answers1