Thanks.
With the MS example I managed something to make that works with the dir
function. It will need a bit of refinement:
Function FindFiles(path As String, _
SearchStr As String, _
FileCount As Long, _
DirCount As Long) As Variant
Dim FileName As String 'Walking filename variable.
Dim DirName As String 'SubDirectory Name.
Dim dirNames() As String 'Buffer for directory name entries.
Dim nDir As Integer 'Number of directories in this path.
Dim i As Integer 'For-loop counter.
Static arrFiles
If FileCount = 0 Then
ReDim arrFiles(1 To 10000000) As String
End If
On Error GoTo sysFileERR
If Right(path, 1) < "\" Then
path = path & "\"
End If
'Search for subdirectories.
nDir = 0
ReDim dirNames(nDir)
DirName = Dir(path, vbDirectory Or vbHidden Or vbArchive Or vbReadOnly _
Or vbSystem) 'Even if hidden, and so on.
Do While Len(DirName) 0
'Ignore the current and encompassing directories.
If (DirName < ".") And (DirName < "..") Then
'Check for directory with bitwise comparison.
If GetAttr(path & DirName) And vbDirectory Then
dirNames(nDir) = DirName
DirCount = DirCount + 1
nDir = nDir + 1
ReDim Preserve dirNames(nDir)
End If 'directories.
sysFileERRCont:
End If
DirName = Dir() 'Get next subdirectory.
Loop
'Search through this directory and sum file sizes.
FileName = Dir(path & SearchStr, _
vbNormal Or _
vbHidden Or _
vbSystem Or _
vbReadOnly Or _
vbArchive)
While Len(FileName) < 0
FileCount = FileCount + 1
arrFiles(FileCount) = path & FileName
FileName = Dir() 'Get next file.
Wend
'If there are sub-directories..
If nDir 0 Then
'Recursively walk into them
For i = 0 To nDir - 1
FindFiles path & dirNames(i) & "\", _
SearchStr, _
FileCount, _
DirCount
Next
End If
FindFiles = arrFiles
AbortFunction:
Exit Function
sysFileERR:
If Right(DirName, 4) = ".sys" Then
Resume sysFileERRCont 'Known issue with pagefile.sys
Else
MsgBox "Error: " & Err.Number & " - " & Err.Description, , _
"Unexpected Error"
Resume AbortFunction
End If
End Function
Sub test()
Dim i As Long
Dim arr
arr = FindFiles("C:\TestFolder", _
"*.txt", _
0, _
0)
For i = 1 To 1000000
Cells(i, 1) = arr(i)
If arr(i) = "" Then
MsgBox i - 1
Exit For
End If
Next
End Sub
RBS
"Tom Ogilvy" wrote in message
...
http://support.microsoft.com/default...b;en-us;185476
How To Search Directories to Find or List Files
this is a link to that article for the third method
http://support.microsoft.com/kb/185601/EN-US/
HOW TO: Recursively Search Directories by Using FileSystemObject
--
Regards,
Tom Ogilvy
"RB Smissaert" wrote in message
...
Here is some nice code from Randy Birch to do a recursive filesearch with
the Windows API:
http://vbnet.mvps.org/index.html?cod...es_minimal.htm
RBS
"Jeff" wrote in message
...
The code below is used to select files which will then be zipped up and
saved
to a location. I am trying to automate the process completly to avoid
the
users missing files in their selection process.
Since I know that the files I want are excel, I thought I could use the
Dir
command to return a list of the files just like i get inthe immediate
window.
Any ideas or direction?
FileNameXls = Dir("\\CCT75-F3-FIL03\GLOBALSHARE01\PMD PMO\F05
Files\Monthly-Project LE\02+10 Post Act Projects\Project over
$1MM\CIS\*.xls")
'Application.GetOpenFilename(filefilter:="Excel Files, *.xls", _
MultiSelect:=True)
If IsArray(FileNameXls) = False Then
'do nothing
Else
NameList = ""
For iCtr = LBound(FileNameXls) To UBound(FileNameXls)
NameList = NameList & " " & Chr(34) & FileNameXls(iCtr) &
Chr(34)
vArr = Split97(FileNameXls(iCtr), "\")
sFileNameXls = vArr(UBound(vArr))
If bIsBookOpen(sFileNameXls) Then
MsgBox "You can't zip a file that is open!" & vbLf & _
"Please close: " & FileNameXls(iCtr)
Exit Sub
End If
Next iCtr