Macro to print directory structure to Excel cells

E

exceldemon

New Member
Joined
Jun 30, 2010
Messages
38
I am looking for a macro that prints the directory structure to Excel cells.

EX:

C:\Work
C:\Work\Folder1\SubFolder1
C:\Work\Folder1\SubFolder2
C:\Work\Folder2\SubFolder1\SubSubFolder1\
C:\Work\Folder2\SubFolder1\SubSubFolder2\
C:\Work\Folder2\SubFolder2
C:\Work\Folder3\SubFolder1

Has anyone seen one that does this, just folders, no files?

I found this in another thread but it doesnt go deep in the subfolders.

Code: 
Sub ListFoldersAndInfo()
Dim FSO As Object
Dim Folder As Object
Dim FolderName As String
Dim R As Long
Dim Rng As Range
Dim SubFolder As Object
Dim Wks As Worksheet

'Parent Directory - Change this to whichever directory you want to use
FolderName = "S:\0-Completed SolidWorks Models\"

Set Wks = Worksheets("Sheet1")
Set Rng = Wks.Range("A2")
Wks.UsedRange.Offset(1, 0).ClearContents

Set FSO = CreateObject("Scripting.FileSystemObject")

Set Folder = FSO.GetFolder(FolderName)
R = 1
Rng.Cells(R, 1) = Folder.Name
Rng.Cells(R, 2) = Folder.Path

For Each Folder In Folder.SubFolders
R = R + 1
Rng.Cells(R, 1) = Folder.Name
Rng.Cells(R, 2) = Folder.Path
Next Folder

Set FSO = Nothing

End Sub

Thanks in advance.
 

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).
Sort by date Sort by votes
Hi

This code lists a directory structure to the active sheet starting in A1, down.

Try:

Code: 
Sub test()
Dim fs As Object
Dim sFolder As String
 
sFolder = "c:\tmp"
Set fs = CreateObject("Scripting.FileSystemObject")
ListSubFolders sFolder, fs, 1
End Sub
 
Sub ListSubFolders(sFolder As String, fs As Object, lRow As Long)
Dim oFolder As Object, oSubFolder As Object
 
Set oFolder = fs.getfolder(sFolder)
Cells(lRow, "A").Value = oFolder.Path
lRow = lRow + 1
 
' loops though the subfolders
For Each oSubFolder In oFolder.subFolders
    ListSubFolders oSubFolder.Path, fs, lRow
Next oSubFolder
End Sub
 
Upvote 0
exceldemon said:
What if I only want to go 5 subfolders deep?
Click to expand...

Hi

You can monitor the subfolder depth, for ex.:

Code: 
Option Explicit
 
Const MAX_DEPTH As Long = 5
 
Sub test()
Dim fs As Object
Dim sFolder As String
 
sFolder = "c:\tmp"
Set fs = CreateObject("Scripting.FileSystemObject")
ListSubFolders sFolder, fs, 1, 0
End Sub
 
Sub ListSubFolders(sFolder As String, fs As Object, lRow As Long, ByVal lDepth As Long)
Dim oFolder As Object, oSubFolder As Object
 
Set oFolder = fs.getfolder(sFolder)
Cells(lRow, "A").Value = oFolder.Path
lRow = lRow + 1

lDepth = lDepth + 1
If lDepth <> MAX_DEPTH Then
    ' loops though the subfolders
    For Each oSubFolder In oFolder.subFolders
        ListSubFolders oSubFolder.Path, fs, lRow, lDepth
    Next oSubFolder
End If
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

H
  • Solved
VBA to extract most Used Folders
Replies
4
Views
507
howard
H
C
  • Solved
VBA Folder Structure -- Loop Once
Replies
2
Views
497
cwhaley1
C
O
  • Question
VBA Modification: criteria on two subfolder to open
Replies
0
Views
222
OrangeYellow
O
Arie Bos
  • Solved
extracting number from foldername
Replies
6
Views
378
Arie Bos
Arie Bos
D
  • Solved
VBA to provide links to Folders, sub folders and files
Replies
2
Views
742
davidalldred
D

Forum statistics

Threads
1,215,650
Messages
6,126,019
Members
449,280
Latest member
Miahr

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top