Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

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

Posted on 2009-04-14
16
Medium Priority
?
453 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
Independent Software Vendors: 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 2000 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

Independent Software Vendors: 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!

Question has a verified solution.

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

This script will sweep a range of IP addresses (class c only, 255.255.255.0) and report to a log the version of office installed. What it does: 1.)      Creates log file in the directory the script is run from (if it doesn't already exist) 2.)      Sweep…
How to remove superseded packages in windows w60 or w61 installation media (.wim) or online system to prevent unnecessary space. w60 means Windows Vista or Windows Server 2008. w61 means Windows 7 or Windows Server 2008 R2. There are various …
This theoretical tutorial explains exceptions, reasons for exceptions, different categories of exception and exception hierarchy.
This video will show you how to get GIT to work in Eclipse.   It will walk you through how to install the EGit plugin in eclipse and how to checkout an existing repository.

688 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