MS Office Forum

Ask Question   UnAnswered
Home » Forum » MS Office       RSS Feeds

Loop through folders

  Asked By: Trupti    Date: Nov 27    Category: MS Office    Views: 1964

I have 90+ files located in a shared drive within folders and
subfolders as follows...

Y:\Budgets\... in this folder I have 90 subfolders and each subfolder
has one woorkbook.

I want to loop through each subfolder and password protect the files
and I do not know how to loop through the folders and subfolders...

Anyone out there has a code that I can modify to do this?



3 Answers Found

Answer #1    Answered By: Jay Brown     Answered On: Nov 27

You need to use the FSO (FileSystemObject). I have code  I use often to
process files  in a one main dir. In it (which is very similar in base to the
code below) I use the FSO to pull all files from a predefined path variable
(captured from the user) to do [whatever] by putting the files into an Array
and handling each by looping through the array.

Here's some code that I got from Chip Pearson (Excel MVP)...that does about
the same thing, but he uses For/Each to loop  through the files in the dir,
whereas I pull the files into an array, first. Not sure which might be more
efficient? However, Chip's code (below) includes the code to process
subfolders, something that I just haven't had a need for to date. So,
although I haven't used his code...I'm sure it works great and should do
what you need.

Note...You'll need to set a Reference in VBA to the Microsoft Scripting
RunTime Library.

(If you need any further help, search Google groups for:


Sub DoIt()
Dim FSO As Scripting.FileSystemObject
Dim TopFolder As String
Set FSO = New Scripting.FileSystemObject
TopFolder = "C:\FolderName" '<<<<<<<<< CHANGE THIS
InnerProc FSO.GetFolder(TopFolder), FSO
End Sub

Sub InnerProc(F As Scripting.Folder, FSO As

Dim SubFolder As Scripting.Folder
Dim OneFile As Scripting.File
Dim WB As Workbook

For Each SubFolder In F.SubFolders
InnerProc SubFolder, FSO
Next SubFolder
For Each OneFile In F.Files
Debug.Print OneFile.Path
If Right(OneFile.Name, 4) = ".xls" Then
Set WB = Workbooks.Open(Filename:=OneFile.Path)
' your code here
WB.Close savechanges:=True
End If
Next OneFile

End Sub

Answer #2    Answered By: Rae Fischer     Answered On: Nov 27

I've used the below mentioned code  in an excel solution.
I'm a bit surprised over the speed. It takes about 10 sec. (looong time
to wait) to search through a folder  with 2 subfolders, 640 files  in all.

What I do is:

- pick up cell-value by dbl-click on cell
loop  through folders  for files that starts with cell-value (always 5
- matches are put in a list box, from where user can pick to open

The For/Each code:

For Each OneFile In F.Files
Debug.Print OneFile.Name
If Left(OneFile.Name, 5) = ActiveCell.EntireRow.Cells(1,
1).Value Then
UserForm1.ListBox1.AddItem OneFile.Path
End If
Next OneFile

A comparable search from explorer takes less than 1 sec.

Answer #3    Answered By: Xander Thompson     Answered On: Nov 27

I've found a much quicker method:


Sub FindFiles()

Dim Files() As String, stFolder As String, stFiles As String
Dim i As Long

ReDim Files(1 To 1)

stFolder = " "Folder name" "

stFiles = "*" & ActiveCell.EntireRow.Cells(1, 1).Value & "*"

If FindFile(stFolder, stFiles, Files, True) Then
For i = 1 To UBound(Files)
UserForm1.ListBox1.AddItem Files(i)
Next i
End If

End Sub


Function FindFile(stFolder As String, stFil As String, stFilArray() As
String, blSubfolder As Boolean) As Boolean

Dim fsoObj As Scripting.FileSystemObject
Dim fsoFolder As Scripting.Folder
Dim fsoSubFolder As Scripting.Folder
Dim stFileName As String

Set fsoObj = New Scripting.FileSystemObject

If fsoObj.FolderExists(stFolder) Then
Set fsoFolder = fsoObj.GetFolder(stFolder)
MsgBox "Cannot find folder!"
FindFile = False
Exit Function
End If

stFileName = Dir(fsoObj.BuildPath(stFolder, stFil))
If stFilArray(1) = "" Then
stFilArray(1) = stFolder & "\" & stFileName
ReDim Preserve stFilArray(1 To UBound(stFilArray) + 1)
stFilArray(UBound(stFilArray)) = stFileName
End If

Do While stFileName <> ""
stFileName = fsoObj.BuildPath(stFolder, stFileName)
stFileName = Dir()
If stFileName = "" Then
Exit Do
ReDim Preserve stFilArray(1 To UBound(stFilArray) + 1)
stFilArray(UBound(stFilArray)) = stFolder & "\" & stFileName
End If

'If extend to search subfolders
If blSubfolder Then
For Each fsoSubFolder In fsoFolder.SubFolders
FindFile fsoSubFolder.Path, stFil, stFilArray, True
End If

FindFile = True

Set fsoSubFolder = Nothing
Set fsoFolder = Nothing
Set fsoObj = Nothing

End Function

Didn't find what you were looking for? Find more on Loop through folders Or get search suggestion and latest updates.