Re: Adding files to an array using Dir
From: RB Smissaert (bartsmissaert_at_blueyonder.co.uk)
Date: 01/31/05
- Next message: Chip: "Re: Adding text file to a user form?"
- Previous message: Bob Phillips: "Re: Programmatic indication of file to be PROCESSED."
- In reply to: Tom Ogilvy: "Re: Adding files to an array using Dir"
- Next in thread: RB Smissaert: "Re: Adding files to an array using Dir"
- Reply: RB Smissaert: "Re: Adding files to an array using Dir"
- Messages sorted by: [ date ] [ thread ]
Date: Mon, 31 Jan 2005 18:54:10 -0000
Have worked this out now and it is actually very fast and it finds some
files that the routine with
the API didn't find.
A file the API routine missed was:
C:\RBSSynergyReporting\LinkFiles\Smissaert - promote - 1599., 7E04., 7E043,
7E045, 7E046, 7F1A0, 685H.TXT
Haven't looked yet why this would be.
As somebody might find it useful here the code:
Function FindFiles(strPath As String, _
strSearch As String, _
Optional lFileCount As Long = 0, _
Optional lDirCount As Long = 0) As String()
'adapted from the MS example:
'http://support.microsoft.com/default.aspx?scid=kb;en-us;185476
'---------------------------------------------------------------
'will list all the files in the supplied folder and it's
'subfolders that fit the strSearch criteria
'lFileCount and lDirCount will always have to start as 0
'use for example like this:
'Dim arr
'arr = FindFiles("C:\TestFolder", "*.xls")
'---------------------------------------------------------------
Dim strFileName As String 'Walking strFileName variable.
Dim strDirName As String 'SubDirectory Name.
Dim arrDirNames() As String 'Buffer for directory name entries.
Dim nDir As Integer 'Number of directories in this strPath.
Dim i As Integer 'For-loop counter.
Static strStartDirName As String
Static arrFiles
On Error GoTo sysFileERR
If Right(strPath, 1) <> "\" Then
strPath = strPath & "\"
End If
If lFileCount = 0 And lDirCount = 0 Then
ReDim arrFiles(1 To 10000000) As String
strStartDirName = strPath
End If
'Search for subdirectories.
nDir = 0
ReDim arrDirNames(nDir)
strDirName = Dir(strPath, vbDirectory Or vbHidden Or vbArchive Or
vbReadOnly _
Or vbSystem) 'Even if hidden, and so
on.
Do While Len(strDirName) > 0
'Ignore the current and encompassing directories.
If (strDirName <> ".") And (strDirName <> "..") Then
'Check for directory with bitwise comparison.
If GetAttr(strPath & strDirName) And vbDirectory Then
arrDirNames(nDir) = strDirName
lDirCount = lDirCount + 1
nDir = nDir + 1
ReDim Preserve arrDirNames(nDir)
End If 'directories.
sysFileERRCont:
End If
strDirName = Dir() 'Get next subdirectory.
Loop
'Search through this directory
strFileName = Dir(strPath & strSearch, _
vbNormal Or _
vbHidden Or _
vbSystem Or _
vbReadOnly Or _
vbArchive)
While Len(strFileName) <> 0
lFileCount = lFileCount + 1
arrFiles(lFileCount) = strPath & strFileName
strFileName = 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 strPath & arrDirNames(i) & "\", _
strSearch, _
lFileCount, _
lDirCount
Next
End If
'searching the supplied main directory is done last
'so that is when we redim and supply the produced array
'------------------------------------------------------
If strPath & arrDirNames(i) = strStartDirName Then
ReDim Preserve arrFiles(1 To lFileCount)
FindFiles = arrFiles
End If
AbortFunction:
Exit Function
sysFileERR:
If Right(strDirName, 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", "*.xls")
For i = 1 To UBound(arr)
Cells(i, 1) = arr(i)
Next
End Sub
RBS
"Tom Ogilvy" <twogilvy@msn.com> wrote in message
news:uqQFD76BFHA.4008@tk2msftngp13.phx.gbl...
> http://support.microsoft.com/default.aspx?scid=kb;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" <bartsmissaert@blueyonder.co.uk> wrote in message
> news:eRE45x6BFHA.612@TK2MSFTNGP09.phx.gbl...
>> Here is some nice code from Randy Birch to do a recursive filesearch with
>> the Windows API:
>> http://vbnet.mvps.org/index.html?code/fileapi/recursivefiles_minimal.htm
>>
>> RBS
>>
>>
>> "Jeff" <Jeff@discussions.microsoft.com> wrote in message
>> news:9222B8B8-24E7-4C68-A507-5AE22B2772A8@microsoft.com...
>> > 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
>>
>
>
- Next message: Chip: "Re: Adding text file to a user form?"
- Previous message: Bob Phillips: "Re: Programmatic indication of file to be PROCESSED."
- In reply to: Tom Ogilvy: "Re: Adding files to an array using Dir"
- Next in thread: RB Smissaert: "Re: Adding files to an array using Dir"
- Reply: RB Smissaert: "Re: Adding files to an array using Dir"
- Messages sorted by: [ date ] [ thread ]
Relevant Pages
|
