View Single Post
  #11   Report Post  
Posted to microsoft.public.excel.programming
RB Smissaert RB Smissaert is offline
external usenet poster
 
Posts: 2,452
Default Adding files to an array using Dir

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