Dir Function

[Mic Diehl]

Does the DIR function go throught subfolders also? For example if I wanted
all the files on my C:\ including subfolders. Would I use the Dir function
or is there a better way?

Thanks for your help!

 

[Douglas J. Steele]

It does, but probably not in the way you want it to, because you can't use
Dir recursively. In other words, if you've looping through a directory and
find a subdirectory in it, if you try doing a Dir on the subdirectory, you
lose your place in the first Dir loop.

Take a look at http://support.microsoft.com/id=185476 for a more robust
solution.

 

[Albert D. Kallal]

Here is a nice and short (recursive) rouinte that will return all files and
also the sub-folders:

Sub dirTest()

Dim dlist As New Collection
Dim startDir As String
Dim i As Integer

startDir = "C:\access\"
Call FillDir(startDir, dlist)

MsgBox "there are " & dlist.Count & " in the dir"

' lets printout the stuff into debug window for a test

For i = 1 To dlist.Count
Debug.Print dlist(i)
Next i

End Sub


Sub FillDir(startDir As String, dlist As Collection)

' build up a list of files, and then
' add add to this list, any additinal
' folders

Dim strTemp As String
Dim colFolders As New Collection
Dim vFolderName As Variant

strTemp = Dir(startDir)

Do While strTemp <> ""
dlist.Add startDir & strTemp
strTemp = Dir
Loop

' now build a list of additional folders
strTemp = Dir(startDir & "*.", vbDirectory)

Do While strTemp <> ""
If (strTemp <> ".") And (strTemp <> "..") Then
colFolders.Add strTemp
End If
strTemp = Dir
Loop

' now process each folder (recursion)
For Each vFolderName In colFolders
Call FillDir(startDir & vFolderName & "\", dlist)
Next vFolderName

End Sub

 

[Mic Diehl]

Thanks for you help!

Doug, I tried to get to your suggested web page and it said "The Requested
Web Page is Not Available". I can try to get to it later.
While I was waiting for a reply, I tried this code using
Application.FileSearch. This begins with a user clicking a button. What is
your thoughts on using this code?
Thanks again!!
__________________________________________
Private Sub cmdFileSearch_Click()
On Error GoTo ErrcmdFileSearch_Click:

Dim strDrive As String, strFile As String, strFilePath As String

Dim strTableName As String, varReturnFilePath

'validate the drive and file textboxes for entry...
If Len(Me!txtDrive) <= 1 Or IsNull(Me!txtDrive) Then
MsgBox "Need to SELECT a drive.", vbInformation, "FILE INVENTORY
UTILITY"
Me!txtDrive.SetFocus
Exit Sub
ElseIf Len(Me!txtFileSelection) <= 1 Or IsNull(Me!txtFileSelection) Then
MsgBox "No files have been found.", vbInformation, "FILE INVENTORY
UTILITY"
Me!txtFileSelection.SetFocus
Exit Sub
End If


'Initialize form....
strTableName = "tblFileList"
Call subClearTable(strTableName)
Me!subFileList.Requery
Me!txtDisplayFiles = ""

'Gather info to store files...
strDrive = Me!txtDrive & "\"
strFile = Me!txtFileSelection
strFilePath = Dir(strDrive & strFile)


varReturnFilePath = fReturnFilePath(strFile, strDrive)

MsgBox "Inventory Complete", vbExclamation, "FILE INVENTORY UTILITY"
Me!txtDisplayFiles = ""



ExitcmdFileSearch_Click:
Set curDB = Nothing

ErrcmdFileSearch_Click:
If Err.Number <> 0 Then
MsgBox Err.Number & Err.Description
Resume ExitcmdFileSearch_Click:
End If
End Sub



Function fReturnFilePath(strFilename As String, _
strDrive As String) As String

Dim varItm As Variant
Dim strFiles As String
Dim strFileTmp As String
Const cTIME = 200 'in MilliSeconds


strFiles = ""
strTmpDrive = ""
With Application.FileSearch
.NewSearch
.LookIn = strDrive
.SearchSubFolders = True
.FileName = strFilename
.MatchTextExactly = False
.FileType = msoFileTypeAllFiles
If .Execute > 0 Then
For Each varItm In .FoundFiles
strFileTmp = fGetFileName(varItm)
fReturnFilePath = varItm
'Write to mdb table "tblMdbList"
Call subStoreFilesInTable(strTmpDrive, strFileTmp)
'show the files being searched...
DoEvents
Me!txtDisplayFiles = strTmpDrive & strFileTmp
Me!subFileList.Requery
'Call sSleep(cTIME)
Next varItm
End If
End With
End Function


Private Function fGetFileName(strFullPath) As String
Dim intPos As Integer, intLen As Integer
intLen = Len(strFullPath)
If intLen Then
For intPos = intLen To 1 Step -1
'Find the last \
If Mid$(strFullPath, intPos, 1) = "\" Then
strTmpDrive = Left$(strFullPath, intPos)
fGetFileName = Mid$(strFullPath, intPos + 1)
Exit Function
End If
Next intPos
End If
End Function


__________________________________________