VBA help - code to loop through a certain folder structure

[mibushk]

Hello,

I have to create a folder structure in which to introduce a txt file, I do not know how to recursevly go through all folders from the folder structure.
Can you please give me a helping hand, I have searched for a week now this and it is driving me crazy:(

[Bob Phillips]

Dim oFSO

Sub LoopFolders()

Set oFSO = CreateObject("Scripting.FileSystemObject")

selectFiles "c:\MyTest"

Set oFSO = Nothing

End Sub


'---------------------------------------------------------------------------
Sub selectFiles(sPath)
'---------------------------------------------------------------------------
Dim Folder As Object
Dim fldr

Set Folder = oFSO.GetFolder(sPath)

For Each fldr In Folder.Subfolders

MsgBox fldr.Path
Next fldr
End Sub

[mibushk]

Hi,

thank you for replying so fast, I have a small issue regarding your script, it doesnt` go deeper, only it shows the first level

[Bob Phillips]

Sorry, I cut one line too many from my original code



Dim oFSO

Sub LoopFolders()

Set oFSO = CreateObject("Scripting.FileSystemObject")

selectFiles "c:\"

Set oFSO = Nothing

End Sub


'---------------------------------------------------------------------------
Sub selectFiles(sPath)
'---------------------------------------------------------------------------
Dim Folder As Object
Dim fldr

Set Folder = oFSO.GetFolder(sPath)

For Each fldr In Folder.Subfolders

MsgBox fldr.Path

Call selectFiles(fldr.Path)
Next fldr
End Sub

[mibushk]

wow, thank you so much, now it works, perfect

may I still need one help from your part?
how do I know which one is the lowest level? the lowest tree level

thank you

[Bob Phillips]

Lowest level of what? You may have several branches, each with a different level at the bottom.

[mibushk]

I am really sorry to take so much of your time, I am a begginer in the vba world, and I do not want to disturb you with too much work

my task is the following, I have to create a folder structure for a project and it has many lowest levels, I will have to upload this folder structure in another tool, but to do this I have to have a txt file in the lowest level for each branch.

as example I have written the lowest level, I have to create a txt file in the 05_Test_Environment and 02_Output folders

D:\Algorithm\Suzuki\Suzuki\YP6\06_Testing\05_ADConv\05_Test_Environment\
D:\Algorithm\Suzuki\Suzuki\YP6\06_Testing\09_SensorIntegrity\04_Test_Data\0 2_Output\

[mdmackillop]

Are you saying that every folder which does not contain a subfolder should contain your txt file?

[Bob Phillips]

Take a look at this and see if this helps



Option Explicit

Private cnt As Long
Private arfiles As Variant
Private level As Long

Public Function Folders()
Dim i As Long
Dim sFolder As String

arfiles = Array()
cnt = 0
level = 1

sFolder = "C:\personal\bob\_reference"
ReDim arfiles(1 To 2, 1 To 1)
SelectFiles sFolder

'create a sheet to show folder structure
Application.DisplayAlerts = False
On Error Resume Next
Worksheets("Files").Delete
On Error GoTo 0
Application.DisplayAlerts = True
Worksheets.Add.Name = "Files"
With ActiveSheet

For i = LBound(arfiles, 2) To UBound(arfiles, 2)

'If arfiles(1, i) = "" Then

With .Cells(i + 1, arfiles(2, i))

.Value = arfiles(1, i)
.Font.Bold = True
End With
'End If
Next

.Columns("A:Z").ColumnWidth = 5
End With

'just in case there is another set to group

Columns("A:Z").AutoFit

End Function

'-----------------------------------------------------------------------
Sub SelectFiles(Optional sPath As String)
'-----------------------------------------------------------------------
Static FSO As Object
Dim oSubFolder As Object
Dim oFolder As Object

If FSO Is Nothing Then Set FSO = CreateObject("Scripting.FileSystemObject")

cnt = cnt + 1
ReDim Preserve arfiles(1 To 2, 1 To cnt)
arfiles(1, cnt) = sPath
arfiles(2, cnt) = level

Set oFolder = FSO.GetFolder(sPath & "\")

level = level + 1
For Each oSubFolder In oFolder.Subfolders

SelectFiles oSubFolder.Path
Next
level = level - 1

End Sub

[mibushk]

Hello,
I want to tahk you for solving my issue

[mdmackillop]

Hi mibushk
You can mark the thread Solved using the thread tools dropdown
Regards
MD