By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
444,027 Members | 1,273 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 444,027 IT Pros & Developers. It's quick & easy.

Parsing Subdirectories

P: n/a
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
Nov 12 '05 #1
Share this Question
Share on Google+
3 Replies


P: n/a
As you found, Dir() cannot work recursively.

Here is a quick'n'dirty piece of code, adapted for Access VBA from VB code
Randy Birch published at www.mvps.org/vbnet

Paste it into a standard module, and save.

Create a table named "tblFile" to hold the file information. Fields:
FileID AutoNumber
Folder Text (255) directory name
FileName Text(255) name of file (without folder or ext)
FileExt Text(12) name of file extension

Open the Immediate Window (Ctrl+G), and enter:
? ListMyFiles("C:\MyPath")

-------------------------code begins-----------------------------
Private Const vbDot = 46
Private Const MAX_PATH = 260
Private Const INVALID_HANDLE_VALUE = -1
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10

Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type

Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type

Private Type FILE_PARAMS
bRecurse As Boolean
sFileRoot As String
sFileNameExt As String
sResult As String
sMatches As String
Count As Long
End Type

Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long)
As Long

Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA"
_
(ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long

Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" _
(ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long

Private rsTarget As DAO.Recordset
Private dtWhen As Date
Private lngFileCount As Long

Public Function ListMyFiles(strPath As String)
Dim FP As FILE_PARAMS 'holds search parameters

dtWhen = Now()
Set rsTarget = DBEngine(0)(0).OpenRecordset("tblFile")

'set up search params
With FP
.sFileRoot = strPath 'start path
.sFileNameExt = "*" 'file type
.bRecurse = True 'recursive search
End With
Call SearchForFiles(FP)

rsTarget.Close
Set rsTarget = Nothing
ListMyFiles = lngFileCount
End Function

Private Sub SearchForFiles(FP As FILE_PARAMS)
Dim WFD As WIN32_FIND_DATA
Dim hFile As Long
Dim strPath As String
Dim strRoot As String

strRoot = QualifyPath(FP.sFileRoot)
strPath = strRoot & "*.*"

'obtain handle to the first match
hFile = FindFirstFile(strPath, WFD)
If hFile <> INVALID_HANDLE_VALUE Then 'if valid ...
Call GetFileInformation(FP) 'obtains the file list and data for the
folder passed.
Do
'if the returned item is a folder...
If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) Then
If FP.bRecurse Then '..and the Recurse flag was specified
'and if the folder is not the default self and parent
folders (a . or ..)
If Asc(WFD.cFileName) <> vbDot Then
'..then the item is a real folder, which may contain
other sub folders, so assign
'the new folder name to FP.sFileRoot and recursively
call this function again with
'the amended information.
FP.sFileRoot = strRoot & TrimNull(WFD.cFileName)
'remove trailing nulls
Call SearchForFiles(FP)
End If
End If
End If
Loop While FindNextFile(hFile, WFD) 'continue until FindNextFile
returns 0.
hFile = FindClose(hFile) 'close the find handle
End If
End Sub

Private Sub GetFileInformation(FP As FILE_PARAMS)
'local working variables
Dim WFD As WIN32_FIND_DATA
Dim hFile As Long
Dim strPath As String
Dim strRoot As String
Dim strTemp As String
Dim lngPos As Long
Dim varExt As Variant

strRoot = QualifyPath(FP.sFileRoot) 'FP.sFileRoot contains the path to
search.
strPath = strRoot & FP.sFileNameExt 'FP.sFileNameExt contains the full
path and filespec.

'obtain handle to the first filespec match
hFile = FindFirstFile(strPath, WFD)
If hFile <> INVALID_HANDLE_VALUE Then 'if valid ...
Do
'Even though this routine uses file specs, *.* is still valid
and will cause the search
'to return folders as well as files, so a check against folders
is still required.
If Not (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) =
FILE_ATTRIBUTE_DIRECTORY Then
FP.Count = FP.Count + 1
strTemp = TrimNull(WFD.cFileName) 'remove trailing nulls
lngPos = InStrRev(strTemp, ".")
If lngPos > 1 Then 'Don't import if the last dot is in
the first place.
If lngPos > 0 And Len(strTemp) - lngPos < 6 Then
varExt = Mid(strTemp, lngPos + 1)
strTemp = Left(strTemp, lngPos - 1)
Else
varExt = Null
End If

With rsTarget
.AddNew
!Folder = Left(strRoot, Len(strRoot) - 1)
!FileName = strTemp
!FileExt = varExt
.Update
End With
lngFileCount = lngFileCount + 1&
' If lngFileCount Mod 100 = 0 Then
' 'DoCmd.Echo True, lngFileCount
' Debug.Print lngFileCount,
' End If
'Debug.Print Left(strRoot, Len(strRoot) - 1&), strTemp,
varExt
End If
End If
Loop While FindNextFile(hFile, WFD)
hFile = FindClose(hFile) 'close the handle
End If
End Sub

Public Function QualifyPath(strPath As String) As String
'assures that a passed path ends in a slash
If Right$(strPath, 1) <> "\" Then
QualifyPath = strPath & "\"
Else
QualifyPath = strPath
End If
End Function

Private Function TrimNull(strStringN As String) As String
'Purpose: Return a string up to the first null, if present, or the
passed string.
Dim lngPos As Long

lngPos = InStr(strStringN, vbNullChar)
If lngPos Then
TrimNull = Left$(strStringN, lngPos - 1)
Exit Function
End If
TrimNull = strStringN
End Function
--------------------------code ends------------------------------

--
Allen Browne - Microsoft MVP. Perth, Western Australia.
Tips for Access users - http://allenbrowne.com/tips.html
Reply to group, rather than allenbrowne at mvps dot org.

"Neil Ginsberg" <nr*@nrgconsult.com> wrote in message
news:QH*****************@newsread2.news.pas.earthl ink.net...
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

Nov 12 '05 #2

P: n/a
Thanks a bunch, Allen. That'll work great.

Neil

"Allen Browne" <Al*********@SeeSig.Invalid> wrote in message
news:40**********************@freenews.iinet.net.a u...
As you found, Dir() cannot work recursively.

Here is a quick'n'dirty piece of code, adapted for Access VBA from VB code
Randy Birch published at www.mvps.org/vbnet

Paste it into a standard module, and save.

Create a table named "tblFile" to hold the file information. Fields:
FileID AutoNumber
Folder Text (255) directory name
FileName Text(255) name of file (without folder or ext)
FileExt Text(12) name of file extension

Open the Immediate Window (Ctrl+G), and enter:
? ListMyFiles("C:\MyPath")

-------------------------code begins-----------------------------
Private Const vbDot = 46
Private Const MAX_PATH = 260
Private Const INVALID_HANDLE_VALUE = -1
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10

Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type

Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type

Private Type FILE_PARAMS
bRecurse As Boolean
sFileRoot As String
sFileNameExt As String
sResult As String
sMatches As String
Count As Long
End Type

Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long

Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" _
(ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long

Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" _ (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long

Private rsTarget As DAO.Recordset
Private dtWhen As Date
Private lngFileCount As Long

Public Function ListMyFiles(strPath As String)
Dim FP As FILE_PARAMS 'holds search parameters

dtWhen = Now()
Set rsTarget = DBEngine(0)(0).OpenRecordset("tblFile")

'set up search params
With FP
.sFileRoot = strPath 'start path
.sFileNameExt = "*" 'file type
.bRecurse = True 'recursive search
End With
Call SearchForFiles(FP)

rsTarget.Close
Set rsTarget = Nothing
ListMyFiles = lngFileCount
End Function

Private Sub SearchForFiles(FP As FILE_PARAMS)
Dim WFD As WIN32_FIND_DATA
Dim hFile As Long
Dim strPath As String
Dim strRoot As String

strRoot = QualifyPath(FP.sFileRoot)
strPath = strRoot & "*.*"

'obtain handle to the first match
hFile = FindFirstFile(strPath, WFD)
If hFile <> INVALID_HANDLE_VALUE Then 'if valid ...
Call GetFileInformation(FP) 'obtains the file list and data for the folder passed.
Do
'if the returned item is a folder...
If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) Then
If FP.bRecurse Then '..and the Recurse flag was specified 'and if the folder is not the default self and parent
folders (a . or ..)
If Asc(WFD.cFileName) <> vbDot Then
'..then the item is a real folder, which may contain other sub folders, so assign
'the new folder name to FP.sFileRoot and recursively call this function again with
'the amended information.
FP.sFileRoot = strRoot & TrimNull(WFD.cFileName)
'remove trailing nulls
Call SearchForFiles(FP)
End If
End If
End If
Loop While FindNextFile(hFile, WFD) 'continue until FindNextFile
returns 0.
hFile = FindClose(hFile) 'close the find handle
End If
End Sub

Private Sub GetFileInformation(FP As FILE_PARAMS)
'local working variables
Dim WFD As WIN32_FIND_DATA
Dim hFile As Long
Dim strPath As String
Dim strRoot As String
Dim strTemp As String
Dim lngPos As Long
Dim varExt As Variant

strRoot = QualifyPath(FP.sFileRoot) 'FP.sFileRoot contains the path to
search.
strPath = strRoot & FP.sFileNameExt 'FP.sFileNameExt contains the full
path and filespec.

'obtain handle to the first filespec match
hFile = FindFirstFile(strPath, WFD)
If hFile <> INVALID_HANDLE_VALUE Then 'if valid ...
Do
'Even though this routine uses file specs, *.* is still valid
and will cause the search
'to return folders as well as files, so a check against folders is still required.
If Not (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) =
FILE_ATTRIBUTE_DIRECTORY Then
FP.Count = FP.Count + 1
strTemp = TrimNull(WFD.cFileName) 'remove trailing nulls
lngPos = InStrRev(strTemp, ".")
If lngPos > 1 Then 'Don't import if the last dot is in the first place.
If lngPos > 0 And Len(strTemp) - lngPos < 6 Then
varExt = Mid(strTemp, lngPos + 1)
strTemp = Left(strTemp, lngPos - 1)
Else
varExt = Null
End If

With rsTarget
.AddNew
!Folder = Left(strRoot, Len(strRoot) - 1)
!FileName = strTemp
!FileExt = varExt
.Update
End With
lngFileCount = lngFileCount + 1&
' If lngFileCount Mod 100 = 0 Then
' 'DoCmd.Echo True, lngFileCount
' Debug.Print lngFileCount,
' End If
'Debug.Print Left(strRoot, Len(strRoot) - 1&), strTemp, varExt
End If
End If
Loop While FindNextFile(hFile, WFD)
hFile = FindClose(hFile) 'close the handle
End If
End Sub

Public Function QualifyPath(strPath As String) As String
'assures that a passed path ends in a slash
If Right$(strPath, 1) <> "\" Then
QualifyPath = strPath & "\"
Else
QualifyPath = strPath
End If
End Function

Private Function TrimNull(strStringN As String) As String
'Purpose: Return a string up to the first null, if present, or the
passed string.
Dim lngPos As Long

lngPos = InStr(strStringN, vbNullChar)
If lngPos Then
TrimNull = Left$(strStringN, lngPos - 1)
Exit Function
End If
TrimNull = strStringN
End Function
--------------------------code ends------------------------------

--
Allen Browne - Microsoft MVP. Perth, Western Australia.
Tips for Access users - http://allenbrowne.com/tips.html
Reply to group, rather than allenbrowne at mvps dot org.

"Neil Ginsberg" <nr*@nrgconsult.com> wrote in message
news:QH*****************@newsread2.news.pas.earthl ink.net...
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


Nov 12 '05 #3

P: n/a
I was working on my Dir() recursion routine a bit more. I found that the
only problem that Dir() has with recursion is that after it comes out of a
recursion, it's "stuck" on the last item it returned, and never moves on,
creating an endless loop.

So I had the idea of storing the subdirectories that Dir() returns in an
array and just processing the files that it returns. Then, when Dir()'s
finished processing the files, call the directories one-by-one in the array.
Since that would use a For... Next cycle, and not be dependent on Dir()
"remembering" where it left off, it should work.

The modified code is below. I haven't done extensive testing with it, but it
seems to work. Let me know what you think.

Neil
Sub ShowFiles(strDir As String)

Dim strFilename As String
Dim Dirs() As String
Dim i As Integer

If Right(strDir, 1) <> "\" Then strDir = strDir & "\"

ReDim Dirs(0)

strFilename = Dir(strDir & "*.*", vbNormal + vbReadOnly + vbDirectory)
Do While strFilename <> ""
If strFilename <> "." And strFilename <> ".." Then
If (GetAttr(strDir & strFilename) And vbDirectory) = vbDirectory
Then
ReDim Preserve Dirs(UBound(Dirs) + 1)
Dirs(UBound(Dirs)) = strDir & strFilename
Else
Debug.Print strDir & strFilename
End If
End If
strFilename = Dir()
Loop

For i = 1 To UBound(Dirs)
ShowFiles (Dirs(i))
Next

End Sub

"Allen Browne" <Al*********@SeeSig.Invalid> wrote in message
news:40**********************@freenews.iinet.net.a u...
As you found, Dir() cannot work recursively.

Here is a quick'n'dirty piece of code, adapted for Access VBA from VB code
Randy Birch published at www.mvps.org/vbnet

Nov 12 '05 #4

This discussion thread is closed

Replies have been disabled for this discussion.