Parsing Subdirectories

[Neil Ginsberg]

I need to write some code that will get all filenames under a particular
directory and add them to a table, including any in subdirectories. I
realize that Dir can be used to get all filenames in a directory; but how
does one parse an unlimited and unspecified number of subdirectories to get
all filenames? Any good code samples?

Thanks!

Neil

 

[Peter Hewett]

Hi Neil

This is not the best way, I'd probably use the FileSystemObject in the
Scripting library. I'll try to dig through some of my code to see if I have
an example but here's how to do it using the vanilla Dir approach:

Public Sub CreateFileList()
Dim docOutput As Word.Document
Dim strPath As String
Dim strMask As String

' Create document to hold file listing
Set docOutput = Documents.Add

' Path to start search at
strPath = "F:\My Templates\"

' Files to search for
strMask = "*.doc"

' Create listing
ListDocsInFolder docOutput, strPath, strMask
End Sub
Public Sub ListDocsInFolder(ByVal docList As Word.Document, _
ByVal strFolder As String, _
ByVal strFileMask As String)
Dim strFile As String
Dim varFolder As Variant

' Ensure folder path is terminated correctly
strFolder = Trim$(strFolder)
If Right$(strFolder, 1) <> "\" Then strFolder = strFolder & "\"

' List all files in the current folder
strFile = Dir$(strFolder & strFileMask)
Do Until strFile = vbNullString
AddFileNameToDocument docList, strFolder, strFile
strFile = Dir$
Loop

' Now list files in any subfolders of the current folder
For Each varFolder In GetAllSubFolders(strFolder)
ListDocsInFolder docList, strFolder & varFolder, strFileMask
Next
End Sub

Private Function GetAllSubFolders(ByVal strPath As String) As Collection
Dim colFolders As New Collection
Dim strFolder As String

If Right$(strPath, 1) <> "\" Then strPath = strPath & "\"
strFolder = Dir$(strPath, vbDirectory)
Do Until LenB(strFolder) = 0
If strFolder <> "." And strFolder <> ".." Then
If (GetAttr(strPath & strFolder) And vbDirectory) = _
vbDirectory Then
colFolders.Add strFolder
End If
End If
strFolder = Dir$
Loop

' Return collection of this folders sub-folders
Set GetAllSubFolders = colFolders
End Function
Private Sub AddFileNameToDocument(ByVal docList As Word.Document, _
ByVal strFolder As String, _
ByVal strFile As String)
Dim rngEnd As Word.Range

Set rngEnd = docList.Content
rngEnd.Collapse wdCollapseEnd

' Add the path nad file name to the output document
rngEnd.InsertAfter strFolder & strFile & vbCr
End Sub

It creates a list of files in the current document using the drive/folder
specified:
strPath = "F:\My Templates\"

the file search mask is:
strMask = "*.doc"


HTH + Cheers - Peter

 

[Peter Hewett]

Hi Neil

Here's a version that uses the Scripting FileSystemObject. Like the other
one it's recursive. Put the code you want to do something with the file
name or file in the ProcessFile procedure.


' This is the base folder the document property extraction will start at
Const mcBasePath As String = "F:\My Templates\"

' Only files of this type are processed (must be lower case)
Const mcFileTypeMask As String = ".doc"

Private Sub Worker()
Dim fsoTemp As Scripting.FileSystemObject
Dim filStartingFolder As Scripting.Folder

' This speeds things up
Application.ScreenUpdating = False

' You must do this to stop AutoOpen macros from
' firing when the documents are opened
WordBasic.DisableAutoMacros True

' Iterate from base folder extracting data
' from all matching Word documents
Set fsoTemp = New Scripting.FileSystemObject
Set filStartingFolder = fsoTemp.GetFolder(mcBasePath)
ProcessFilesInFolder filStartingFolder

' Tidy up...
Application.ScreenUpdating = True
WordBasic.DisableAutoMacros False
End Sub ' Worker

Private Sub ProcessFilesInFolder(ByVal folCurrentFolder _
As Scripting.Folder)
Dim folSubFolder As Scripting.Folder
Dim filToProcess As Scripting.File

' Process files in the current folder
For Each filToProcess In folCurrentFolder.Files

' Only process files of the appropriate file type
If LCase$(Right$(filToProcess.Name, Len(mcFileTypeMask))) = _
mcFileTypeMask Then
ProcessFile filToProcess
End If
Next filToProcess

' Now process files in any subfolders of the current folder
For Each folSubFolder In folCurrentFolder.SubFolders
ProcessFilesInFolder folSubFolder
Next
End Sub ' ProcessFilesInFolder

Private Sub ProcessFile(ByVal filWordDoc As Scripting.File)
Dim docCurrent As Word.Document
Dim offDocProperty As Office.DocumentProperty

On Error GoTo ProcessFileError

Debug.Print filWordDoc.Path
ActiveDocument.Content.InsertAfter filWordDoc.Path & vbCr
''' Set docCurrent = Documents.Open(filWordDoc.Path)
'''
'''
''' ' We're done with the document
''' docCurrent.Close wdDoNotSaveChanges

ProcessFileExit:
Exit Sub

ProcessFileError:
' Report unable to process file error here
Debug.Print "Unable to process document, error: " & Err.Number & ", " _
& Err.Description
Resume ProcessFileExit
End Sub ' ProcessFile


HTH + Cheers - Peter

 

[Martin Seelhofer]

Hi Neil

The Application.FileSearch-object might be something for you

NB: It allows access to the found files through the FoundFiles-
collection


Cheers,
Martin

 

[Tushar Mehta]

For a readymade solution, check the Excel/Add-Ins/Directory List page
of my web site.

--
Regards,

Tushar Mehta, MS MVP -- Excel
www.tushar-mehta.com
Excel, PowerPoint, and VBA add-ins, tutorials
Custom MS Office productivity solutions

 

[Neil Ginsberg]

Your solution is great; but I'm working in Access.

Thanks,

Neil

 

[Neil Ginsberg]

Thanks, Peter. I think I found a solution using Dir(). See my note to Allen
Browne in this thread. Thanks,

Neil