Solved

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

Posted on 2009-04-14
16
444 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 10
  • 6
16 Comments
 
LVL 67

Expert Comment

by:sirbounty
ID: 24139741
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
ID: 24140871
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
ID: 24141310
Nope :(  Still only returns the subdirectories directly below the root path.
0
Technology Partners: 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!

 

Author Comment

by:electricd7
ID: 24141363
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
ID: 24141603
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
ID: 24141615
By the way - my Program Files is about 11.6GB and it took 10 seconds to run...
0
 

Author Comment

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

Author Comment

by:electricd7
ID: 24141861
Guess I can omit line 27 :)
0
 
LVL 67

Expert Comment

by:sirbounty
ID: 24141863
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
ID: 24141881
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
ID: 24141902
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
ID: 24141977
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
ID: 24142086
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
ID: 24142145
No, I get type mismatch when I call it now.
0
 
LVL 67

Accepted Solution

by:
sirbounty earned 500 total points
ID: 24142160
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
ID: 24142299
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

Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Over the years I have built up my own little library of code snippets that I refer to when programming or writing a script.  Many of these have come from the web or adaptations from snippets I find on the Web.  Periodically I add to them when I come…
This article is meant to give a basic understanding of how to use R Sweave as a way to merge LaTeX and R code seamlessly into one presentable document.
This tutorial covers a step-by-step guide to install VisualVM launcher in eclipse.
Viewers will learn how to properly install Eclipse with the necessary JDK, and will take a look at an introductory Java program. Download Eclipse installation zip file: Extract files from zip file: Download and install JDK 8: Open Eclipse and …

762 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