Dir Function

  • Thread starter Thread starter Mic Diehl
  • Start date Start date
M

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!
 
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.
 
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
 
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


__________________________________________
 
Back
Top