Iterate all Subfolders and write Path to text file 1

[tqeonline]

I have a folder path that I need to iterate through to grab ALL the folders underneath and plot their path

This is what I have so far:

Option Explicit
 Dim strFolderToSearch, objFSO, objRootFolder, objFolder, colSubfolders, strOutput

 strFolderToSearch = "C:\Users\mloflin\Desktop\New folder\"

 Set objFSO = CreateObject("Scripting.FileSystemObject")
 Set objRootFolder = objFSO.GetFolder(strFolderToSearch)
 Set colSubfolders = objRootFolder.SubFolders

 For Each objFolder in colSubfolders
      strOutput = strOutput & objFolder.name
      strOutput = strOutput &  vbCrLf
 Next

 MsgBox strOutput

The output that I need is a text file that will show the tree structure for everything within strFolderToSearch

Example:

..\Folder1..\Folder1\SubFolder1..\Folder1\SubFolder2..\Folder1\SubFolder2\SubSubFolder1\

I don't care about the files - more the tree structure. I'm going to dump this into excel and do some other formatting but don't know how to continuously iterate subfolders without knowing the level of depth.



- Matt

"If I must boast, I will boast of the things that show my weakness

 

[tqeonline]

I have it appending to a text file. Now I need help on how to iterate through subfolders.

Any ideas?

Option Explicit
Dim strFolderToSearch,strTextFile, objFSO, objRootFolder, objFolder, colSubfolders, strOutput, objTextFile 

strFolderToSearch = "C:\Users\mloflin\Desktop\New folder\"
strTextFile = "C:\Users\mloflin\Desktop\text.txt"

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objRootFolder = objFSO.GetFolder(strFolderToSearch)
Set colSubfolders = objRootFolder.SubFolders
Set objTextFile = objFSO.OpenTextFile (strTextFile, 8, True)

For Each objFolder in colSubfolders   
     objTextFile.WriteLine(objFolder.name)
Next

objTextFile.Close

MsgBox "Complete"

- Matt

"If I must boast, I will boast of the things that show my weakness

 

[guitarzan]

You need to use a recursive function/sub. Check out this FAQ: faq329-5515

You wouldn't need the first For/Next loop (because you dont care about the files) but inside the second For/Next loop (which loops through the subfolders) should first write that path to your textfile, then call the same function recursively, passing in that subfolder.

Not tested, but here is roughly how you could modify the code in the FAQ to get the job done.

Sub getInfo(pCurrentDir)

[s]   For Each aItem In pCurrentDir.Files
      'wscript.Echo aItem.Name
      If LCase(Right(Cstr(aItem.Name), 3)) = "bak" Then
       'do file manip, copy delete here
      End If
   Next[/s]

   For Each aItem In pCurrentDir.SubFolders
      [highlight #FCE94F]objTextFile.WriteLine(aItem.Path)[/highlight]
      getInfo(aItem)
   Next

End Sub

 

[tqeonline]

Perfect.

Here is the finished product:

Option Explicit
Dim strFolderToSearch, intCounter, strTextFile, objFSO, objRootFolder, objFolder, colSubfolders, strOutput, objTextFile 

strFolderToSearch = "C:\Users\mloflin\Desktop\New folder\"
strTextFile = "C:\Users\mloflin\Desktop\text.txt"
intCounter = 0

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objRootFolder = objFSO.GetFolder(strFolderToSearch)
Set colSubfolders = objRootFolder.SubFolders
Set objTextFile = objFSO.OpenTextFile (strTextFile, 8, True)

Call GetFolderSize (strFolderToSearch)

objTextFile.Close

MsgBox "Complete"


Function GetFolderSize(strFolderPath)

Dim objCurrentFolder, colSubfolders, objFolder

intCounter = intCounter +1

if objFSO.FolderExists(strFolderPath) Then
	Set objCurrentFolder = objFSO.GetFolder(strFolderPath)
	Set colSubfolders = objCurrentFolder.SubFolders

	For Each objFolder In colSubfolders 
		objTextFile.WriteLine(objFolder.path)		
		GetFolderSize (objFolder.Path) 
	Next 
End If 

End Function

- Matt

"If I must boast, I will boast of the things that show my weakness

 

[guitarzan]

Well, that was fast! Glad you got it working.

 

[PHV]

A simplified version:

Option Explicit
Dim strFolderToSearch, strTextFile, objFSO, objRootFolder, objTextFile

strFolderToSearch = "C:\Users\mloflin\Desktop\New folder\"
strTextFile = "C:\Users\mloflin\Desktop\text.txt"

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objRootFolder = objFSO.GetFolder(strFolderToSearch)
Set objTextFile = objFSO.OpenTextFile(strTextFile, 8, True)
GetFolderSize objRootFolder
objTextFile.Close

MsgBox "Complete"

Sub GetFolderSize(objCurrentFolder)
Dim objFolder
For Each objFolder In objCurrentFolder.SubFolders
  objTextFile.WriteLine objFolder.Path
  GetFolderSize objFolder
Next
End If
End Sub

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886