Solved

Trying to get an array of all subfolders within a given root folder VBScript

Posted on 2009-04-14
16
439 Views
Last Modified: 2012-05-06
Hello,

I found a script on another question that accepts a baseroot string and then gets all subfolders within that baseroot.  It works fine for the first level of subfolders, but I need it to return the subfolders of the subfolders etc.  The directory tree may go down 10 or 15 levels, but I need each subdirectory to be added to the array.  The function I found previously was:

Function GetFolders(BaseFolder)
Dim oBaseFolder
Dim SubFolder
Dim strArr

   Set oBaseFolder = oFSO.GetFolder(BaseFolder)
   For Each SubFolder In oBaseFolder.SubFolders
      If Not IsEmpty(SubFolder) Then
         strArr = strArr & "+" & Mid(SubFolder, Len(BaseFolder) + 1)
      End If
   Next

   GetFolders = Split(Mid(strArr, 2), "+")
   Set oBaseFolder = Nothing

End Function

Where basefolder might be "\\servername\share\directory"  There are essentially thousands of subdirectories in that baseroot, but the above function only returns the 12 main subdirectories directly below the root.  Thanks!
0
Comment
Question by:electricd7
  • 10
  • 6
16 Comments
 
LVL 67

Expert Comment

by:sirbounty
Comment Utility
Try this:
Function GetFolders(BaseFolder)

Dim oBaseFolder

Dim SubFolder

Dim strArr
 

   Set oBaseFolder = oFSO.GetFolder(BaseFolder)

   For Each SubFolder In oBaseFolder.SubFolders

      If Not IsEmpty(SubFolder) Then

         strArr = strArr & "+" & Mid(SubFolder, Len(BaseFolder) + 1)

      End If

      GetFolders(SubFolder)

   Next
 

   GetFolders = Split(Mid(strArr, 2), "+")

   Set oBaseFolder = Nothing
 

End Function

Open in new window

0
 

Author Comment

by:electricd7
Comment Utility
Running the new code now.  I ran it on the entire folder, so it might be a bit before I know anything since there are thousands of folders.  I will post back as soon as it completes.  Thanks!.
0
 

Author Comment

by:electricd7
Comment Utility
Nope :(  Still only returns the subdirectories directly below the root path.
0
 

Author Comment

by:electricd7
Comment Utility
Here is the example code that can be named whatever.vbs to show what I am getting

SourceRoot = "c:\program files"

LogFileName = "c:\FindFiles.log"
 

Set oFSO = CreateObject("Scripting.FileSystemObject")

Set oShell = CreateObject("Wscript.Shell")
 
 

   If Not oFSO.FolderExists(SourceRoot) Then

      Wscript.Echo "Path to root of SOURCE is invalid."

      StopNow = True

   End If
 
 

   If StopNow Then

      Wscript.Echo "Terminating due to error(s)."

      Set oFSO = Nothing

      Set oShell = Nothing

      Wscript.Quit(16)

   End If
 

Set oLog = oFSO.CreateTextFile(LogFileName)	

oLog.WriteLine Date & " : " & Time & " - Beginning scan."

aSrcFolders = GetFolders(SourceRoot)

For n = 0 To UBound(aSrcFolders)

   oLog.WriteLine Date & " : " & Time & "  Folder: " & SourceRoot & aSrcFolders(n)

Next
 

Function GetFolders(BaseFolder)

Dim oBaseFolder

Dim SubFolder

Dim strArr

 

   Set oBaseFolder = oFSO.GetFolder(BaseFolder)

   For Each SubFolder In oBaseFolder.SubFolders

      If Not IsEmpty(SubFolder) Then

         strArr = strArr & "+" & Mid(SubFolder, Len(BaseFolder) + 1)

      End If

      GetFolders(SubFolder)

   Next

 

   GetFolders = Split(Mid(strArr, 2), "+")

   Set oBaseFolder = Nothing
 

End Function

Open in new window

0
 
LVL 67

Expert Comment

by:sirbounty
Comment Utility
Not sure why the time recording, but I prefer a dictionary approach, just the same
Try this...you can exclude the date/time if necessary by only referencing the item.
SourceRoot = "c:\program files"

LogFileName = "c:\FindFiles.log"
 

Set oFSO = CreateObject("Scripting.FileSystemObject")

Set dSFI = CreateObject("Scripting.Dictionary")

Set oShell = CreateObject("Wscript.Shell")
 

 

   If Not oFSO.FolderExists(SourceRoot) Then

      Wscript.Echo "Path to root of SOURCE is invalid."

      StopNow = True

   End If

 

 

   If StopNow Then

      Wscript.Echo "Terminating due to error(s)."

      Set oFSO = Nothing

      Set oShell = Nothing

      Wscript.Quit(16)

   End If
 

Set oLog = oFSO.CreateTextFile(LogFileName)     

oLog.WriteLine Date & " : " & Time & " - Beginning scan." 
 

GetSubFolders (SourceRoot)
 

oLog.WriteLine Date & " : " & Time & "  Folder: " & SourceRoot & aSrcFolders(n)
 
 

For each item in dSFI.Keys

  oLog.WriteLine dSFI(item) & " " & item

Next
 

oLog.Close
 

 

Sub GetSubFolders (strFolder)

  Set objFld = oFSO.GetFolder (strFolder)

  For Each fld in objFld.SubFolders

    dSFI.Add "Folder: " & fld, Date & " : " & Time

    GetSubFolders (fld)

  Next

End Sub

Open in new window

0
 
LVL 67

Expert Comment

by:sirbounty
Comment Utility
By the way - my Program Files is about 11.6GB and it took 10 seconds to run...
0
 

Author Comment

by:electricd7
Comment Utility
I am getting type mismatch 'aSrcFolders' on line 27 char 1
0
 

Author Comment

by:electricd7
Comment Utility
Guess I can omit line 27 :)
0
Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

 
LVL 67

Expert Comment

by:sirbounty
Comment Utility
Oh - I'd taken your oLog lines out for testing and just dropped them back in without double-checking...that line can be completely removed...
SourceRoot = "c:\program files"

LogFileName = "c:\FindFiles.log"

 

Set oFSO = CreateObject("Scripting.FileSystemObject")

Set dSFI = CreateObject("Scripting.Dictionary")

Set oShell = CreateObject("Wscript.Shell")

 

 

   If Not oFSO.FolderExists(SourceRoot) Then

      Wscript.Echo "Path to root of SOURCE is invalid."

      StopNow = True

   End If

 

 

   If StopNow Then

      Wscript.Echo "Terminating due to error(s)."

      Set oFSO = Nothing

      Set oShell = Nothing

      Wscript.Quit(16)

   End If

 

Set oLog = oFSO.CreateTextFile(LogFileName)     

oLog.WriteLine Date & " : " & Time & " - Beginning scan." 

 

GetSubFolders (SourceRoot)

 

'oLog.WriteLine Date & " : " & Time & "  Folder: " & SourceRoot & aSrcFolders(n)

 

 

For each item in dSFI.Keys

  oLog.WriteLine dSFI(item) & " " & item

Next

 

oLog.Close

 

 

Sub GetSubFolders (strFolder)

  Set objFld = oFSO.GetFolder (strFolder)

  For Each fld in objFld.SubFolders

    dSFI.Add "Folder: " & fld, Date & " : " & Time

    GetSubFolders (fld)

  Next

End Sub

Open in new window

0
 

Author Comment

by:electricd7
Comment Utility
OK then...the date and time and folder: or any of that is important, but what is important is getting those values back into an array instead of on the text file.  Can you make that happen, and I can close the question?  Thanks again!
0
 
LVL 67

Expert Comment

by:sirbounty
Comment Utility
Get 'what' exactly in an array.  A dictionary is basically the same - just allows for both data.
What are you trying to do exactly?
0
 

Author Comment

by:electricd7
Comment Utility
each line of that text file should be an item in the array like in the original question:

strArr = strArr & "+" & Mid(SubFolder, Len(BaseFolder) + 1)
GetFolders = Split(Mid(strArr, 2), "+")

So when I call the function, I get an array back with each value being a single directory.
0
 

Author Comment

by:electricd7
Comment Utility
Would this work:
Sub GetSubFolders (BaseFolder)

Dim objFld, fld

  Set objFld = oFSO.GetFolder (BaseFolder)

  For Each fld in objFld.SubFolders

    strArr = strArr & "+" & fld

    GetSubFolders (fld)

  Next

  

  GetSubFolders = Split(Mid(strArr, 2), "+")

End Sub

Open in new window

0
 

Author Comment

by:electricd7
Comment Utility
No, I get type mismatch when I call it now.
0
 
LVL 67

Accepted Solution

by:
sirbounty earned 500 total points
Comment Utility
Right - GetSubFolders is a sub - it doesn't return anything (a Function does).
However, if you're just looking to add a + symbol between the results, try this:
SourceRoot = "c:\program files"

LogFileName = "c:\FindFiles.log"

 

Set oFSO = CreateObject("Scripting.FileSystemObject")

Set dSFI = CreateObject("Scripting.Dictionary")

Set oShell = CreateObject("Wscript.Shell")

 

 

   If Not oFSO.FolderExists(SourceRoot) Then

      Wscript.Echo "Path to root of SOURCE is invalid."

      StopNow = True

   End If

 

 

   If StopNow Then

      Wscript.Echo "Terminating due to error(s)."

      Set oFSO = Nothing

      Set oShell = Nothing

      Wscript.Quit(16)

   End If

 

Set oLog = oFSO.CreateTextFile(LogFileName)     

oLog.WriteLine Date & " : " & Time & " - Beginning scan." 

 

GetSubFolders (SourceRoot)

 

'oLog.WriteLine Date & " : " & Time & "  Folder: " & SourceRoot & aSrcFolders(n)

 

 

For each item in dSFI.Keys

  oLog.WriteLine dSFI(item) & " + " & item

Next

 

oLog.Close

 

 

Sub GetSubFolders (strFolder)

  Set objFld = oFSO.GetFolder (strFolder)

  For Each fld in objFld.SubFolders

    dSFI.Add "Folder: " & fld, Date & " : " & Time

    GetSubFolders (fld)

  Next

End Sub

Open in new window

0
 

Author Comment

by:electricd7
Comment Utility
Duh...I get it.  The logging part isn't important and in fact I omitted it.  The writing the values back as an array is important.  Thanks for the help, here's your points!  I have included the finished script minus the logging for a reference for me later.  
SourceRoot = "c:\program files"

LogFileName = "c:\FindFiles.log"

 

Set oFSO = CreateObject("Scripting.FileSystemObject")

Set dSFI = CreateObject("Scripting.Dictionary")

Set oShell = CreateObject("Wscript.Shell")

 

 

   If Not oFSO.FolderExists(SourceRoot) Then

      Wscript.Echo "Path to root of SOURCE is invalid."

      StopNow = True

   End If

 

 

   If StopNow Then

      Wscript.Echo "Terminating due to error(s)."

      Set oFSO = Nothing

      Set oShell = Nothing

      Wscript.Quit(16)

   End If

 

 

   aSrcFolders = GetSubFolders (SourceRoot)

   For n = 0 To UBound(aSrcFolders)

      'Do something here

   Next 

 

 

Function GetSubFolders (BaseFolder)

Dim objFld, fld, strArr

  Set objFld = oFSO.GetFolder (BaseFolder)

  For Each fld in objFld.SubFolders

    strArr = strArr & "+" & fld

    GetSubFolders (fld)

  Next

  

  GetSubFolders = Split(Mid(strArr, 2), "+")

End Function

Open in new window

0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

Navigation is an important part of web design from a usability perspective. But it is often a pain when it comes to a developer’s perspective. By navigation, it often means menuing. This is less theory and more practical of how to get a specific gro…
When we want to run, execute or repeat a statement multiple times, a loop is necessary. This article covers the two types of loops in Python: the while loop and the for loop.
The goal of the video will be to teach the user the difference and consequence of passing data by value vs passing data by reference in C++. An example of passing data by value as well as an example of passing data by reference will be be given. Bot…
The viewer will be introduced to the technique of using vectors in C++. The video will cover how to define a vector, store values in the vector and retrieve data from the values stored in the vector.

763 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

5 Experts available now in Live!

Get 1:1 Help Now