July 10, 2017

How to Loop through SubFolders

How to Loop through Sub-Folders of a folder automatically using VBA and perform actions on the workbooks. We have already learnt how to loop through files in a folder. Often we may need to loop through sub-folders in a folder, select data in a specific sheet and transfer it to another workbook where we can consolidate the data.

Watch the video below:

 

Watch this video on YouTube.

Here’s the complete VBA code:

Sub LoopFolders()
Dim myFolder As String
Dim mySubFolder As String
Dim myFile As String
Dim collSubFolders As New Collection
Dim myItem As Variant
Dim wbk As Workbook

‘ set parent folder with trailing backslash

myFolder = “C:\Projects\”
‘Retrieve first sub-folder
mySubFolder = Dir(myFolder & “*”, vbDirectory)

Application.ScreenUpdating = False

‘Do While Not mySubFolder = “”
Do While mySubFolder <> “”
Select Case mySubFolder
Case “.”, “..”

‘ ignore current folder or parent folder

Case Else
‘ Add to collection called collSubFolders
‘collSubFolders.Add Item:=mySubFolder, Key:=mySubFolder
collSubFolders.Add Item:=mySubFolder

End Select

‘ Get next entry

mySubFolder = Dir
Loop

‘ Loop through the collection
For Each myItem In collSubFolders

‘ Loop through Excel workbooks in subfolder

myFile = Dir(myFolder & myItem & “\*.xls*”)

 

Do While myFile <> “”

‘ Open workbook

Set wbk = Workbooks.Open(Filename:=myFolder & myItem & “\” & myFile)

‘ Copy data from the opened workbook

lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
lastcolumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
ActiveSheet.Range(Cells(2, 1), Cells(lastrow, lastcolumn)).Copy
‘ Close opened workbook without saving any changes
wbk.Close SaveChanges:=False
erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Cells(erow, 1).Select
ActiveSheet.Paste
ActiveWorkbook.Save
Application.CutCopyMode = False
myFile = Dir
Loop
Next myItem
Application.ScreenUpdating = True
End Sub

6 thoughts on “How to Loop through SubFolders

  1. Are there any microsoft reference libraries we have to check before this code can run?

  2. Hello Dinesh
    I have used your exact code to try to loop through files in multiples subfolders. I have been unsuccessful and I’m wondering if you could proofread my code? The code seems to be failing on line: For Each myItem In collSubFolders.
    To further explain my goal: I am trying to loop though a folder with subfolders for every year from 2012 – 2018. Within these 6 folders are multiple files, and I want to only files with names: 1157, 1135, 1190, 1153 so I have tried setting myFile = Dir(myFolder & myItem & “\11*.xls*”). In each one of these files, I want to only access worksheets with month names (“January -> December”). This is very complicated, and I have made a lot of progress with your code, but I need your help getting all the way there. Could you help me? If you are willing to help, the deadline for this project is this Wednesday.

    Sub Non_Equine_Data()

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Dim myFolder As String, mySubFolder As String, myFile As String, Month As String, Year As String
    Dim collSubFolders As New Collection
    Dim WSNameMonth As Variant, myItem As Variant, i As Variant
    WSNameMonth = Array(“January”, “February”, “March”, “April”, “May”, “June”, “July”, “August”, “September”, “October”, “November”, “December”)
    Dim ANKRows As Integer, ANKCols As Integer, SYMCol As Integer
    Dim LastRow As Long
    Dim DataAnchor As Range, DestinationCell As Range
    Dim Dest As Workbook, wkb As Workbook

    Set Dest = Workbooks.Open(FileName:= _
    “S:\ “FilePath for destination worksheet” ” _
    , UpdateLinks:=0)

    myFolder = “S:\ “FolderPath” \”
    mySubFolder = Dir(FolderPath & “*”, vbDirectory)

    Do While mySubFolder “”
    Select Case mySubFolder
    Case “.”, “..”
    Case Else
    collSubFolders.Add Item:=mySubFolder
    End Select
    mySubFolder = Dir
    Loop

    For Each myItem In collSubFolders
    myFile = Dir(myFolder & myItem & “\11*.xls*”)

    Do While myFile “”
    Set wkb = Workbooks.Open(FileName:=myFolder & myItem & “\” & myFile, UpdateLinks:=0)

    For i = 0 To 11
    Sheets(WSNameMonth(i)).Select

    ”””’CODE: copy and paste data to a database”””

    Next i

    ActiveWorkbook.Save
    ActiveWorkbook.Close

    myFile = Dir()
    Loop

    Next myItem

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

    End Sub

  3. hi Dinesh

    How can I assign different passwords to all the excel workbooks in the folder? let say for file path in Cell B2 should be assigned with password in C2 file path in Cell B3 should be assigned with password in C3…etc
    file name file path Password
    101 C:\user\vba\myproject.xlsx 111
    102 C:\user\vba\myproject2.xlsx 213
    103 C:\user\vba\myproject3.xlsx 987
    I found most of the VBA codes available are mainly related to assign one single password to all the file under the same folder, but I got over 1000 files need to be assigned with different passwords, can it be done by VBA

  4. Thank you sir, what if I’m looping in a folder-sub folder-sub folder? Can I add one more sub folder code? For example: folder- each borrower folder- application folder

Comments are closed.