VBS Script to List All Folders and Sub Folders

Thomas Grassi
Thomas Grassi used Ask the Experts™
on
Trying to list all folders and sub folders only of a main folder. do not want the files included in this list.

I found this but can not get it to run

Dim Mypath as string, MyName as String,iCount as integer
iCount=0
MyPath = "M:\MUSIC\MP#MUSICALBUMS"   ' Set the path.
MyName = Dir(MyPath, vbDirectory)   ' Retrieve the first entry.
Do While MyName <> ""   ' Start the loop.
   ' Ignore the current directory and the encompassing directory.
   If MyName <> "." And MyName <> ".." Then
      ' Use bitwise comparison to make sure MyName is a directory.
      If (GetAttr(MyPath & MyName) And vbDirectory) = vbDirectory Then
         Debug.Print MyName   ' Display entry only if it
         iCount=iCount+1
     End If   ' it represents a directory.
   End If
   MyName = Dir   ' Get next entry.
Loop
debug.print "No.of Folders in the selected path : " & iCount

Open in new window



also tried this one

Sub Ck()     
    Dim strStartPath As String     
    strStartPath = "M:\MUSIC\MP3MUSICALBUMS" 'ENTER YOUR START FOLDER HERE
    ListFolder strStartPath     
End Sub 
Sub ListFolder(sFolderPath As String)     
    Dim FS As New FileSystemObject 
    Dim FSfolder As Folder 
    Dim subfolder As Folder 
    Dim i As Integer     
    Set FSfolder = FS.GetFolder(sFolderPath)     
    For Each subfolder In FSfolder.SubFolders 
        DoEvents 
        i = i + 1 
         'added this line
        Cells(i, 1) = subfolder 
         'commented out this one
         'Debug.Print subfolder
    Next subfolder     
    Set FSfolder = Nothing     
     'optional, I suppose
    MsgBox "Total sub folders in " & sFolderPath & " : " & i     
End Sub 

Open in new window




Sample one fails unexpected end of statement line 1 char 12

Sample two fails unexpected end of statement line 2 char 22
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Most Valuable Expert 2012
Top Expert 2014

Commented:
You can use a DOS command
dir /s/ad/b M:\Music\MP3MUSICALBUMS

Rob.
Most Valuable Expert 2012
Top Expert 2014

Commented:
Otherwise your second block of code will work as long as your click Tools --> References, and tick Microsoft Scripting Runtime.

Rob.
Thomas GrassiSystems Administrator

Author

Commented:
Rob thanks for responding

Yes that is what I am trying to do with the VB script.

Need this for a web page I am building

Wish I could use the dos command.
Ensure you’re charging the right price for your IT

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden using our free interactive tool and use it to determine the right price for your IT services. Start calculating Now!

Most Valuable Expert 2012
Top Expert 2014

Commented:
Oh, and the code you have posted is VBA as well, so you need to run Excel, and paste it into a Module in the VBE.  That's also where you add the reference I mentioned.
Thomas GrassiSystems Administrator

Author

Commented:
To your second response

Where do I found the tools menu in what program?
Most Valuable Expert 2012
Top Expert 2014

Commented:
For a web page, try this (untested)
    Dim strStartPath
    strStartPath = "C:\TEMP\SCRIPTS" 'ENTER YOUR START FOLDER HERE
    ListFolder strStartPath

Sub ListFolder(sFolderPath)
    Set FS = CreateObject("Scripting.FileSystemObject")
    Set FSfolder = FS.GetFolder(sFolderPath)     
    i = 0
    For Each subfolder In FSfolder.SubFolders 
    	i = i + 1
         Response.Write subfolder
    Next
    Set FSfolder = Nothing     
    Response.Write "Total sub folders in " & sFolderPath & " : " & i
End Sub 

Open in new window

Thomas GrassiSystems Administrator

Author

Commented:
Rob getting close.

Check out my site www.tomsmp3.com/music5.asp

Can we list each entry on separate line?

Can we not list the path m:\music\mp3music

This only listed one level of folders


This one I found but it stops on the second main folder

check this

http://blogs.technet.com/b/heyscriptingguy/archive/2007/01/27/how-can-i-get-a-list-of-all-the-subfolders-in-a-folder-and-then-put-that-list-into-an-array.aspx

You can figure this out better than I can.

On Error Resume Next

Dim arrFolders()
intSize = 0

strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")

strFolderName = "M:\music\mp3musicalbums"

Set colSubfolders = objWMIService.ExecQuery _
    ("Associators of {Win32_Directory.Name='" & strFolderName & "'} " _
        & "Where AssocClass = Win32_Subdirectory " _
            & "ResultRole = PartComponent")

ReDim Preserve arrFolders(intSize)
arrFolders(intSize) = strFolderName
intSize = intSize + 1

For Each objFolder in colSubfolders
    GetSubFolders strFolderName
Next

Sub GetSubFolders(strFolderName)
    Set colSubfolders2 = objWMIService.ExecQuery _
        ("Associators of {Win32_Directory.Name='" & strFolderName & "'} " _
            & "Where AssocClass = Win32_Subdirectory " _
                & "ResultRole = PartComponent")

    For Each objFolder2 in colSubfolders2
        strFolderName = objFolder2.Name
        ReDim Preserve arrFolders(intSize)
        arrFolders(intSize) = strFolderName
        intSize = intSize + 1
        GetSubFolders strFolderName
    Next
End Sub

For Each strFolder in arrFolders
    Wscript.Echo strFolder
Next

Open in new window




Update

It stops when it hits a folder with an ' apostrophe  in it

renamed one and it went past that.
Most Valuable Expert 2012
Top Expert 2014

Commented:
Your latest code is vbscript, and I'm not sure the WMI query would work when it's a webpage.  In my code, you can change
         Response.Write subfolder

Open in new window


to
         Response.Write "<BR>" & subfolder

Open in new window


to have it put the folders on separate lines.

If you don't want the whole path, use
         Response.Write Replace(subfolder, strStartPath, "")

Open in new window


Regards,

Rob.
Thomas GrassiSystems Administrator

Author

Commented:
Rob,

Thanks for the response

Made the above changes to your code

Still getting the path on the output.

Each line now on separate line that great

Other issue is that it is only producing the first level of folders under my strStartPath = "M:\MUSIC\MP3MUSICALBUMS"

I am trying to get dir /s/ad/b M:\Music\MP3MUSICALBUMS to work in this code.

check out the site www.tomsmp3.com/music5.asp
Most Valuable Expert 2012
Top Expert 2014

Commented:
OK, again, untested, but I've added a recursive call to the same function:
    Dim strStartPath
    strStartPath = "C:\TEMP\SCRIPTS" 'ENTER YOUR START FOLDER HERE
    ListFolder strStartPath

Sub ListFolder(sFolderPath)
    Set FS = CreateObject("Scripting.FileSystemObject")
    Set FSfolder = FS.GetFolder(sFolderPath)     
    i = 0
    For Each subfolder In FSfolder.SubFolders 
    	i = i + 1
         Response.Write "<BR>" & Replace(subfolder.Path, strStartPath, "", 1, -1, vbTextCompare)
         ListFolder subfolder.Path
    Next
    Set FSfolder = Nothing     
    'Response.Write "Total sub folders in " & sFolderPath & " : " & i
End Sub 

Open in new window


Rob.
Thomas GrassiSystems Administrator

Author

Commented:
Rob,

Thanks for the fast response will test this when I get home today.
Most Valuable Expert 2012
Top Expert 2014

Commented:
No problem.  It's late Friday night for me now, so I might be a bit longer in replying.
Thomas GrassiSystems Administrator

Author

Commented:
Rob

Home

Tried it getting this on one line
Microsoft VBScript compilation  error '800a0401'

Expected end of statement

/music5.asp, line 18
Response.Write "<BR>" "Total Albums in " " : " & i
----------------------------------^
<%Response.Buffer = true%>
<%
    Dim strStartPath
    strStartPath = "M:\MUSIC\MP3MUSICALBUMS" 'ENTER YOUR START FOLDER HERE
    ListFolder strStartPath

Sub ListFolder(sFolderPath)
    Set FS = CreateObject("Scripting.FileSystemObject")
    Set FSfolder = FS.GetFolder(sFolderPath)     
    i = 0
    For Each subfolder In FSfolder.SubFolders 
    	i = i + 1
         Response.Write "<BR>" & Replace(subfolder.Path, strStartPath, "", 1, -1, vbTextCompare)
         ListFolder subfolder.Path
    Next
    Set FSfolder = Nothing     
    End Sub
Response.Write "<BR>" "Total Albums in " " : " & i  
%>

Open in new window


Would like the totals at the end

Can we get ride of the first \

Check out the site www.tomsmp3.com/music5.asp

Can we put a check box on each line also

Thanks Tom
Most Valuable Expert 2012
Top Expert 2014

Commented:
To get rid of the leading slash, put a slash on the end of strStartPath. The replace function will then remove that.  You are missing ampersands in your totals line:
Response.Write "<BR>Total Albums in " & strStartPath & " : " & i

I will add the check boxes later on when I get more time.

Rob.
Thomas GrassiSystems Administrator

Author

Commented:
Rob

Thanks that worked

Thanks for working on the check box.

Two things with current code.

1. The Total is blank the line is displayed but no total I believe the value is being cleared out.

2. Can we place a blank line between each new artist


!!!
!!!\Louden Up Now
!!!\Me and Guiliani Down by the Sc
100 Proof Aged In Soul
100 Proof Aged In Soul\Billboard Top 100 - 1970
10000 Maniacs
10000 Maniacs\Billboard Top 100 - 1994
10000 Maniacs\Billboard Top 100 - 1997

Can it be like this

!!!
!!!\Louden Up Now
!!!\Me and Guiliani Down by the Sc

100 Proof Aged In Soul
100 Proof Aged In Soul\Billboard Top 100 - 1970

10000 Maniacs
10000 Maniacs\Billboard Top 100 - 1994
10000 Maniacs\Billboard Top 100 - 1997
Most Valuable Expert 2012
Top Expert 2014

Commented:
Hi, see how this goes.

Regards,

Rob.

<%Response.Buffer = True%>
<%
	Dim strStartPath, i, strPreviousFolder
    i = 0
    strStartPath = "M:\MUSIC\MP3MUSICALBUMS" 'ENTER YOUR START FOLDER HERE
	strPreviousFolder = ""
    ListFolder strStartPath
	Response.Write "<BR><BR>Total Albums in " & strStartPath & " : " & i  

Sub ListFolder(sFolderPath)
    Set FS = CreateObject("Scripting.FileSystemObject")
    Set FSfolder = FS.GetFolder(sFolderPath)
    strCurrentFolder = Replace(sFolderPath, strStartPath, "", 1, -1, vbTextCompare)
	If InStr(strCurrentFolder, "\") > 0 Then strCurrentFolder = Left(strCurrentFolder, InStr(strCurrentFolder, "\") - 1)
	If strCurrentFolder <> strPreviousFolder Then
		Response.Write "<BR>"
		strPreviousFolder = strCurrentFolder
	End If
	If strCurrentFolder <> "" Then
		i = i + 1
		Response.Write "<BR><input type='checkbox' id=chkAlbum" & i & "' name='chkAlbum" & i & "' value='" & Replace(sFolderPath, strStartPath, "", 1, -1, vbTextCompare) & "'>" & Replace(sFolderPath, strStartPath, "", 1, -1, vbTextCompare)
	End If
    For Each subfolder In FSfolder.SubFolders
         ListFolder subfolder.Path
    Next
End Sub
%>

Open in new window

Thomas GrassiSystems Administrator

Author

Commented:
Rob

Thanks

tried the code from above and now all I get in the display

Total Albums in M:\MUSIC\MP3MUSICALBUMS : 0

Check it out www.tomsmp3.com/music5.asp
Most Valuable Expert 2012
Top Expert 2014

Commented:
That's odd. Do you have an error on the page (usually shows the exclamation mark in the bottom left corner)? On the Response.write line that has the checkbox in it, can you change that to
Response.Write "<BR>" & Replace(sFolderPath, strStartPath, "", 1, -1, vbTextCompare)
And see if it shows the folders?

Rob.
Thomas GrassiSystems Administrator

Author

Commented:
Rob,

Tried that same results

<%Response.Buffer = True%>
<%
	Dim strStartPath, i, strPreviousFolder
    i = 0
    strStartPath = "M:\MUSIC\MP3MUSICALBUMS" 'ENTER YOUR START FOLDER HERE
	strPreviousFolder = ""
    ListFolder strStartPath
	Response.Write "<BR><BR>Total Albums in " & strStartPath & " : " & i  

Sub ListFolder(sFolderPath)
    Set FS = CreateObject("Scripting.FileSystemObject")
    Set FSfolder = FS.GetFolder(sFolderPath)
    strCurrentFolder = Replace(sFolderPath, strStartPath, "", 1, -1, vbTextCompare)
	If InStr(strCurrentFolder, "\") > 0 Then strCurrentFolder = Left(strCurrentFolder, InStr(strCurrentFolder, "\") - 1)
	If strCurrentFolder <> strPreviousFolder Then
		Response.Write "<BR>"
		strPreviousFolder = strCurrentFolder
	End If
	If strCurrentFolder <> "" Then
		i = i + 1
		'Response.Write "<BR><input type='checkbox' id=chkAlbum" & i & "' name='chkAlbum" & i & "' value='" & Replace(sFolderPath, strStartPath, "", 1, -1, vbTextCompare) & "'>" & Replace(sFolderPath, strStartPath, "", 1, -1, vbTextCompare)
	     Response.Write "<BR>" & Replace(sFolderPath, strStartPath, "", 1, -1, vbTextCompare)
	End If
    For Each subfolder In FSfolder.SubFolders
         ListFolder subfolder.Path
    Next
End Sub
%>

Open in new window



check it out
Most Valuable Expert 2012
Top Expert 2014

Commented:
Ok. I can't test it at the moment, can you comment out line 14 and see what happens?
Most Valuable Expert 2012
Top Expert 2014
Commented:
Ah, I see the problem.  You didn't put the trailing slash on the end of strStartPath, so line 14 was clearing the current folder variable.

I have now fixed that, and forced a slash to be on the end of strStartPath, whether you put there  or not.

Regards,

Rob.

<%Response.Buffer = True%>
<%
	Dim strStartPath, i, strPreviousFolder
	i = 0
	strStartPath = "M:\MUSIC\MP3MUSICALBUMS" 'ENTER YOUR START FOLDER HERE
	If Right(strStartPath, 1) <> "\" Then strStartPath = strStartPath & "\"
	strPreviousFolder = ""
	ListFolder strStartPath
	Response.Write "<BR><BR>Total Albums in " & strStartPath & " : " & i  

Sub ListFolder(sFolderPath)
	Set FS = CreateObject("Scripting.FileSystemObject")
	Set FSfolder = FS.GetFolder(sFolderPath)
	strCurrentFolder = Replace(sFolderPath, strStartPath, "", 1, -1, vbTextCompare)
	If InStr(strCurrentFolder, "\") > 0 Then strCurrentFolder = Left(strCurrentFolder, InStr(strCurrentFolder, "\") - 1)
	If strCurrentFolder <> strPreviousFolder Then
		Response.Write "<BR>"
		strPreviousFolder = strCurrentFolder
	End If
	If strCurrentFolder <> "" Then
		i = i + 1
		Response.Write "<BR><input type='checkbox' id=chkAlbum" & i & "' name='chkAlbum" & i & "' value='" & Replace(sFolderPath, strStartPath, "", 1, -1, vbTextCompare) & "'>" & Replace(sFolderPath, strStartPath, "", 1, -1, vbTextCompare)
	End If
	For Each subfolder In FSfolder.SubFolders
		ListFolder subfolder.Path
	Next
End Sub
%>

Open in new window

Thomas GrassiSystems Administrator

Author

Commented:
Rob,

Thanks for all your help  Last bit of code working now.

Now onto getting the checkbox code working

I might post another question when I run into a question on that
Most Valuable Expert 2012
Top Expert 2014

Commented:
No problem, thanks for the grade. If you need me to look at another question, and I miss it, post here and I'll take a look.

Rob.
Thomas GrassiSystems Administrator

Author

Commented:
Rob,

Been trying to design my next step.

One thing on the page that you built for me

Currently it looks like this which is ok but I am trying to do a search from the check boxes and I think I need see below :

!!!
!!!\Louden Up Now
!!!\Me and Guiliani Down by the Sc

100 Proof Aged In Soul
100 Proof Aged In Soul\Billboard Top 100 - 1970

10000 Maniacs
10000 Maniacs\Billboard Top 100 - 1994
10000 Maniacs\Billboard Top 100 - 1997


This would be better I think.

!!!
Louden Up Now
Me and Guiliani Down by the Sc

100 Proof Aged In Soul
Billboard Top 100 - 1970

10000 Maniacs
Billboard Top 100 - 1994
Billboard Top 100 - 1997


Also can we remove the check box on the artist name
If they click that box the they would get what they are already seeing I think.
So it would be best not to give them that option What you think?


Also I just posted another question

http://www.experts-exchange.com/Programming/Languages/Scripting/ASP/Q_28426019.html

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial