Go Premium for a chance to win a PS4. Enter to Win

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 463
  • Last Modified:

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

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
electricd7
Asked:
electricd7
  • 10
  • 6
1 Solution
 
sirbountyCommented:
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
 
electricd7Author Commented:
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
 
electricd7Author Commented:
Nope :(  Still only returns the subdirectories directly below the root path.
0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
electricd7Author Commented:
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
 
sirbountyCommented:
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
 
sirbountyCommented:
By the way - my Program Files is about 11.6GB and it took 10 seconds to run...
0
 
electricd7Author Commented:
I am getting type mismatch 'aSrcFolders' on line 27 char 1
0
 
electricd7Author Commented:
Guess I can omit line 27 :)
0
 
sirbountyCommented:
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
 
electricd7Author Commented:
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
 
sirbountyCommented:
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
 
electricd7Author Commented:
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
 
electricd7Author Commented:
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
 
electricd7Author Commented:
No, I get type mismatch when I call it now.
0
 
sirbountyCommented:
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
 
electricd7Author Commented:
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

Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

  • 10
  • 6
Tackle projects and never again get stuck behind a technical roadblock.
Join Now