Solved

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

Posted on 2009-04-14
16
441 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
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
 

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
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
groupSumClump challenge 9 98
how to add field in my script 2 31
rhino JavaScript import, load 25 66
Advice in Xamarin 21 48
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.
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.
This theoretical tutorial explains exceptions, reasons for exceptions, different categories of exception and exception hierarchy.
The viewer will be introduced to the member functions push_back and pop_back of the vector class. The video will teach the difference between the two as well as how to use each one along with its functionality.

919 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

24 Experts available now in Live!

Get 1:1 Help Now