Macro Trick

At this point, I’ve been doing VBA programming long enough that I can “read” my codes and know a code line is supposed to be doing. More importantly, I’m starting to be able to “read” other snippets of codes, so that’s a nice accomplishment. So maybe I can call myself beginner/intermediate?

In addition, I think I’m now at a point where I can look through the debugger area and see what potentials there are. As an example I wanted to be able to create a directory list of folders and either a list of file names or, more preferably, a count of the number of files in the folders. We have a project going on at work and I wanted to be able to track the status. I’ve previously have been able to create a list of file names but not folder names, so I “googled” on using VBA to create a list of folders and came upon Chip Pearson’s solution.

The link to the particular page is here: http://www.cpearson.com/Excel/QuickTree.aspx

---

Here’s his code:

Sub CreateFolderTree() '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' CreateFolderTree ' By Chip Pearson, chip@cpearson.com , www.cpearson.com ' This creates a hierarchical directory listing tree. ' Requires a reference to the Scripting library (Microsoft ' Scripting Runtime). '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim FSO As Scripting.FileSystemObject 
Dim FolderName As String 
Dim StartFolder As Scripting.Folder 
Dim SubF As Scripting.Folder 
Dim F As Scripting.File 
Dim R As Range 
Dim Indent As Boolean 
Dim FullPaths As Boolean 
Set FSO = New Scripting.FileSystemObject 

' Prompt the user for the top level directory. 
FolderName = InputBox("Enter the top folder of the directory tree") 

' Get out if no file was selected. 
If Trim(FolderName) = vbNullString Then
     Exit Sub Else
     If Dir(FolderName, vbDirectory) = vbNullString Then
         Exit Sub
     End If
End If

 Set StartFolder = FSO.GetFolder(FolderName)

 ' Change the reference held by R to the first cell of the results tree. Set R = ActiveSheet.Range("A1")

 ' Indent = True creates an indented list showing the hierarchical nature ' of the folders. Indent = False creates a single column list.

 Indent = True

 ' FullPaths = True lists the fully qualified directory name. FullPaths = False ' lists the directory name only, with no path information. 

FullPaths = True

 ' Start the process
 DoOneFolder WhatFolder:=StartFolder, WriteTo:=R, Indent:=Indent, FullPaths:=FullPaths
 End Sub
 '============================================== '============================================== 
Sub DoOneFolder(WhatFolder As Scripting.Folder, WriteTo As Range, _         Optional Indent As Boolean = False, _         Optional FullPaths As Boolean = False)

 Dim SubF As Scripting.Folder
 If FullPaths = True Then
     WriteTo.Value = WhatFolder.Path
 Else
     WriteTo.Value = WhatFolder.Name
 End If

 ' move the target cell down one row
 Set WriteTo = WriteTo(2, 1)
 For Each SubF In WhatFolder.SubFolders
     ' For every subfolder in WhatFolder, call this
     ' same procedure passing it the file name. This
     ' recursion spans the entire directory tree.
     If Indent = True Then
         Set WriteTo = WriteTo(1, 2)
     End If
     If FullPaths = True Then
         WriteTo.Value = SubF.Path
     Else
         WriteTo.Value = SubF.Name
     End If

    ' Call ourself using SubF.
     DoOneFolder WhatFolder:=SubF, WriteTo:=WriteTo, Indent:=Indent, FullPaths:=FullPaths
     If Indent = True Then
         Set WriteTo = WriteTo(1, 0)
    End If
 Next SubF
 End Sub 

Here’s my code, altered to fit what I wanted:

Sub CreateFolderTree()
 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 ' CreateFolderTree
 ' By Chip Pearson, chip@cpearson.com , www.cpearson.com
 ' This creates a hierarchical directory listing tree.
 ' Requires a reference to the Scripting library (Microsoft
 ' Scripting Runtime).
 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 Dim FSO As Scripting.FileSystemObject
 Dim FolderName As String
 Dim StartFolder As Scripting.Folder
 Dim SubF As Scripting.Folder
 Dim F As Scripting.File
 Dim R As Range
 Dim Indent As Boolean
 Dim FullPaths As Boolean
 Set FSO = New Scripting.FileSystemObject
 
 SheetName = ActiveSheet.Name

 'Clear prior information
 Sheets(SheetName).Activate
 Range("A1:O500000").ClearContents

 'Get first folder that you want tree created
 FolderName = Sheets(SheetName).Range("W4")

 ' Get out if no file was selected.
 If Trim(FolderName) = vbNullString Then
     Exit Sub
 Else
     If Dir(FolderName, vbDirectory) = vbNullString Then
         Exit Sub
     End If
 End If
 Set StartFolder = FSO.GetFolder(FolderName)
 ' Change the reference held by R to the first cell of the results tree.
 Set R = ActiveSheet.Range("A1")
 ' Indent = True creates an indented list showing the hierarchical nature
 ' of the folders. Indent = False creates a single column list.
 Indent = True
 ' FullPaths = True lists the fully qualified directory name. FullPaths = False
 ' lists the directory name only, with no path information.
 FullPaths = False
 ' Start the process
 DoOneFolder WhatFolder:=StartFolder, WriteTo:=R, Indent:=Indent, FullPaths:=FullPaths
 End Sub
 '==============================================
 '==============================================
 Sub DoOneFolder(WhatFolder As Scripting.Folder, WriteTo As Range, _
         Optional Indent As Boolean = False, _
         Optional FullPaths As Boolean = False)
 Dim SubF As Scripting.Folder
 If FullPaths = True Then
     WriteTo.Value = WhatFolder.Path
 Else
     WriteTo.Value = WhatFolder.Name
 End If
 ' move the target cell down one row
 Set WriteTo = WriteTo(2, 1)
 For Each SubF In WhatFolder.SubFolders
     ' For every subfolder in WhatFolder, call this
     ' same procedure passing it the file name. This
     ' recursion spans the entire directory tree.
     If Indent = True Then
         Set WriteTo = WriteTo(1, 2)
     End If
     If FullPaths = True Then
         WriteTo.Value = SubF.Path
     Else
         WriteTo.Value = SubF.Name
     End If

' Call ourself using SubF.
     DoOneFolder WhatFolder:=SubF, WriteTo:=WriteTo, Indent:=Indent, FullPaths:=FullPaths

 If Indent = True Then
         Set WriteTo = WriteTo(1, 0)
 End If
 Next SubF
 End Sub
 

---

Now, I will admit that I don’t really understand what his code is doing, at least not all of it. There’s some parts of it that is mysterious but it is not enough to stop me from figuring out how to use it. Someday, after more programming, I’ll understand it more fully.

Anyway, his code provides a solution to creating a list of folders which was perfect but I also wanted a count of the number of files. Now I’ve been doing enough debugging to notice that you can gain a lot of information if you delve into the folders found in VBA’s Local windows which shows you the folders and variables, the type, and the contents in the variables when you are stepping into the code line by line. This Local windows is very handy because it can tell you what number or data resides in the variable and that might help you determine the problem. When you open up the folders in the Locals window, you can see lots of information which can give you ideas.

Here’s a screenshot of the toolbar containing the “step through” tool which I’ve highlighted.

I click on that tool button and step through the code line by line.

After I step through the code line that applies the active sheet’s name to the variable SheetName, the Locals window show that name in SheetName – which in the example shown is “List”.

Here’s an example of FolderName being assigned a name of a folder as a starting point. This folder name is pulled from the SheetName “List” and is the one that I want to create a list of folders and file count.

After I step through the code that initiates the looping through the folders, the first instance of that loop assigns the first folder to WhatFolder and you can see that in Locals window. But notice, there is a folder called Files which if you open up, you will see a variable called Count.

And here’s a screenshot with Files opened up:

Using this File and Count, I decided to try to see if I could use those, along with Chip’s program to pull in the number of files in each folder. Here’s the code I used; it is Chip’s program with a few alterations.

Sub CreateFileCount()
 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 ' CreateFolderTree
 ' By Chip Pearson, chip@cpearson.com , www.cpearson.com
 ' This creates a hierarchical directory listing tree.
 ' Requires a reference to the Scripting library (Microsoft
 ' Scripting Runtime).
 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 Dim FSO As Scripting.FileSystemObject
 Dim FolderName As String
 Dim StartFolder As Scripting.Folder
 Dim SubF As Scripting.Folder
 Dim F As Scripting.File
 Dim S As Range
 Dim Indent As Boolean
 Dim FullPaths As Boolean

 Set FSO = New Scripting.FileSystemObject

 'Set up
 SheetName = ActiveSheet.Name

 'Get first folder that you want tree created
 FolderName = Sheets(SheetName).Range("W4")

 Set StartFolder = FSO.GetFolder(FolderName)

 ' Change the reference held by S to the first cell of the results tree.
 Set S = ActiveSheet.Range("B1")
 ' Indent = True creates an indented list showing the hierarchical nature
 ' of the folders. Indent = False creates a single column list.
 Indent = True
 ' FullPaths = True lists the fully qualified directory name. FullPaths = False
 ' lists the directory name only, with no path information.
 FullPaths = False
 ' Start the process
 DoOneFolder2 WhatFolder:=StartFolder, WriteTo:=S, Indent:=Indent, FullPaths:=FullPaths
 End Sub
 '==============================================
 '==============================================
 Sub DoOneFolder2(WhatFolder As Scripting.Folder, WriteTo As Range, _
         Optional Indent As Boolean = False, _
         Optional FullPaths As Boolean = False)
 Dim SubF As Scripting.Folder
 If FullPaths = True Then
     WriteTo.Value = WhatFolder.Path
 Else
     WriteTo.Value = WhatFolder.Files.Count
 End If

 ' move the target cell down one row
 Set WriteTo = WriteTo(2, 1)
 For Each SubF In WhatFolder.SubFolders
     ' For every subfolder in WhatFolder, call this
     ' same procedure passing it the file name. This
     ' recursion spans the entire directory tree.
     If Indent = True Then
         Set WriteTo = WriteTo(1, 2)
     End If
     If FullPaths = True Then
         WriteTo.Value = SubF.Path
     Else
         WriteTo.Value = WhatFolder.Files.Count
     End If
' Call ourself using SubF.
     DoOneFolder2 WhatFolder:=SubF, WriteTo:=WriteTo, Indent:=Indent, FullPaths:=FullPaths

     If Indent = True Then
         Set WriteTo = WriteTo(1, 0)
     End If
 Next SubF
 End Sub

And it works!