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
