Open all excel files in Folder and Sub Folder

[vbanoob1234]

Hello everyone,

I currently have a macro that opens all excel files in a folder. However, I want to take this macro one step further, and open all excel files in the folder, and sub folder.

Subfolder names are not consistent.

Please see my macro below:

Current Macro Explanation:
- open all xls. in a source folder of my choice (want it to do this for sub-folders)
- creates a worksheet called "Master" at the end
- list all worksheet names in the "Master" worksheet
- save change, closes workbook
- next workbook

Any help is appreciated. Thanks



Dim wb As Workbook, ws As Worksheet
Dim sFil As String, sPath As String
Set wb = ActiveWorkbook
Set ws = ActiveSheet

Application.ScreenUpdating = True


'OPENS THE PATH OF FOLDER - want to make it open all excel in sub folders as well
sPath = "G:\<acronym title="visual basic for applications" style="border-******* 0px 0px **** border-top-style: initial; border-right-style: initial; border-bottom-style: dotted; border-left-style: initial; border-top-color: initial; border-right-color: initial; border-bottom-color: rgb(0, 0, 0); border-left-color: initial; border-image: initial; cursor: help; color: rgb(51, 51, 51); background-color: rgb(250, 250, 250);">VBA</acronym>\ARFilesTesting" 'location of files, don't forget the "" at the end
sFil = Dir(sPath & "*.xls") 'change or add formats


Application.DisplayAlerts = False


'FIND ALL THE FILES
Do Until sFil = ""
Workbooks.Open sPath & sFil
Set wb = ActiveWorkbook


Application.ScreenUpdating = False

'CREATE A WORKSHEET AT THE END CALLED "MASTER"
Set wsht = ActiveWorkbook.Sheets.Add(After:= _
ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count))
wsht.Name = "Master"


'LIST ALL WORKSHEETS NAMES
Dim x As Integer


For x = 1 To Worksheets.Count
Cells(x, 1).Value = Worksheets(x).Name
Next x

ActiveWorkbook.Close savechanges:=True


Next


sFil = Dir()
Loop
Application.DisplayAlerts = True


End Sub

 

[John_w]

Subfolder or subfolders?

This function returns the path of the first subfolder in a folder:

Private Function First_Subfolder(folder As String) As String
    Dim subfolder As Object
    For Each subfolder In CreateObject("Scripting.FileSystemObject").GetFolder(folder).SubFolders
        Exit For
    Next
    First_Subfolder = subfolder.path
End Function

Call it like this from your code:

    Dim subfolder As String
    subfolder = First_Subfolder(sPath)

Then basically repeat your code to operate on the subfolder path (put the common code in a sub procedure and call it with the folder path then the subfolder path).

Subfolders is similar - use the same .GetFolder(folder).SubFolders construction to loop through all subfolders.

Please use CODE tags with VBA code.

 

[vbanoob1234]

Hi John,

Subfolders. I was looking at a post of yours from a few years ago related to the same issue. How would I run scripting on Excel?

http://www.mrexcel.com/forum/excel-...h-all-xls-files-subdirectories-directory.html

 

[John_w]

That code only loops through files in the main folder and the first level of subfolders.

Try this code which adds the Master sheet to all Excel workbooks in the main folder and all subfolders.

Public Sub Add_Master_Sheet_To_All_Workbooks_All_Subfolders_LB()
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Process_Workbooks_In_Folder "G:\<acronym title="visual basic for applications" style="border-******* 0px 0px **** border-top-style: initial; border-right-style: initial; border-bottom-style: dotted; border-left-style: initial; border-top-color: initial; border-right-color: initial; border-bottom-color: rgb(0, 0, 0); border-left-color: initial; border-image: initial; cursor: help; color: rgb(51, 51, 51); background-color: rgb(250, 250, 250);">VBA</acronym>\ARFilesTesting"
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
    MsgBox "Done"
    
End Sub


Private Sub Process_Workbooks_In_Folder(folderPath As String)
   
    Static FSO As Object
    Dim Folder As Object, Subfolder As Object, File As Object
    
    If FSO Is Nothing Then Set FSO = CreateObject("Scripting.FileSystemObject")

    'Process files in this folder
    
    Set Folder = FSO.GetFolder(folderPath)
    
    For Each File In Folder.Files
        If File.Name Like "*.xls" Then
            Add_Master_Sheet File.Path
        End If
    Next
    
    'Process files in subfolders
    
    For Each Subfolder In Folder.SubFolders
        Process_Workbooks_In_Folder Subfolder.Path
    Next

End Sub


Private Sub Add_Master_Sheet(workbookFilepath As String)

    Dim wb As Workbook
    Dim masterSheet As Worksheet
    Dim i As Integer
    
    Set wb = Workbooks.Open(workbookFilepath)
    
    With wb
        
        'Does the Master sheet already exist in this workbook?
        
        Set masterSheet = Nothing
        On Error Resume Next
        Set masterSheet = .Worksheets("Master")
        On Error GoTo 0
        
        If masterSheet Is Nothing Then
        
            'No, so add the Master sheet at the end
            
            Set masterSheet = .Worksheets.Add(after:=.Worksheets(.Worksheets.Count))
            masterSheet.Name = "Master"
        End If
        
        'List all worksheet names
        
        For i = 1 To .Worksheets.Count
            masterSheet.Cells(i, 1).Value = .Worksheets(i).Name
        Next

        .Close saveChanges:=True
        
    End With

End Sub

The code uses late binding of FileSystemObject, so no references are needed.