Finding files in a directory

[farful]

Hi, I'm having a problem, not sure if it's VBA related or if there'
something wrong with my system. I have the following code:


Code
-------------------

Sub test()
Set fs = Application.FileSearch
With fs
.NewSearch
.FileType = msoFileTypeExcelWorkbooks
.LookIn = "\\directory\"
.Filename = "3000333*"
If .Execute > 0 Then
MsgBox "There were " & .FoundFiles.Count & _
" file(s) found."
For i = 1 To .FoundFiles.Count
MsgBox .FoundFiles(i)
Next i
Else
MsgBox "There were no files found."
End If
End With
End Sub

-------------------


It looks into a specific directory, and tells me how many file
beginning with 3000333 there are in that folder. I have over a thousan
files in the folder, 13 of which begins with 3000333. However, accordin
to this code, it only finds 10. However, if i just use .Filename = "*.*
, that is, search for all the files in the directory, then I get all th
files, including the three that did not appear.

Here are the 13 files that should appear:
30003330x051206.XLS
30003332x051606.XLS
30003333x071206.XLS
30003334x071206.XLS
30003335x021706.XLS
30003335x040706.XLS
30003337x041006.XLS
30003337x061506.XLS
30003338x042506.XLS
30003339x012506.XLS
30003339x021606.XLS
30003339x022306.XLS
30003339x031606.XLS

However, the code does not find 30003333x071206.XLS
30003334x071206.XLS, and 30003337x041006.XLS.
Any suggestions

 

[RB Smissaert]

I would move away from FileSearch and go with Dir.
For one thing it is faster.
Look at the code in the thread: Open Files Macro of 18 July.

RBS

 

[farful]

Look at the code in the thread: Open Files Macro of 18 July.

I'm sorry, could someone link me to this thread. I'm not quite sure how
to go about finding it ;\

 

[RB Smissaert]

OK, this is the whole text:


Use this general purpose function that will put all the files in a folder
(and optionally all the subfolders) in an array.
By looping through the array you can open all the files.


Option Explicit
Private Const lSheetRows As Long = 65536

Function RecursiveFindFiles(strPath As String, _
strSearch As String, _
Optional bSubFolders As Boolean = True, _
Optional bSheet As Boolean = False, _
Optional lFileCount As Long = 0, _
Optional lDirCount As Long = 0) As Variant

'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
'---------------------------------------------------------------

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 Long 'Number of directories in this strPath.
Dim i As Long 'For-loop counter.
Dim n As Long
Dim arrFiles
Static strStartDirName As String
Static strpathOld As String

On Error GoTo sysFileERR

If lFileCount = 0 Then
Static collFiles As Collection
Set collFiles = New Collection
Application.Cursor = xlWait
End If

If Right$(strPath, 1) <> "\" Then
strPath = strPath & "\"
End If

If lFileCount = 0 And lDirCount = 0 Then
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
DoEvents
ReDim Preserve arrDirNames(nDir)
End If 'directories.
sysFileERRCont1:
End If
strDirName = Dir() 'Get next subdirectory

DoEvents
Loop

'Search through this directory
'-----------------------------
strFileName = Dir(strPath & strSearch, _
vbNormal Or _
vbHidden Or _
vbSystem Or _
vbReadOnly Or _
vbArchive)

While Len(strFileName) <> 0

'dump file in sheet
'------------------
If bSheet Then
If lFileCount < lSheetRows Then
Cells(lFileCount + 1, 1) = strPath & strFileName
End If
End If

lFileCount = lFileCount + 1

collFiles.Add strPath & strFileName

If strPath <> strpathOld Then
Application.StatusBar = " " & lFileCount & _
" " & strSearch & " files found. " & _
"Now searching " & strPath
End If

strpathOld = strPath

strFileName = Dir() 'Get next file

DoEvents
Wend

If bSubFolders Then
'If there are sub-directories..
'------------------------------
If nDir > 0 Then
'Recursively walk into them
'--------------------------
For i = 0 To nDir - 1
RecursiveFindFiles strPath & arrDirNames(i) & "\", _
strSearch, _
bSubFolders, _
bSheet, _
lFileCount, _
lDirCount

DoEvents
Next
End If 'If nDir > 0

'only bare main folder left, so get out
'--------------------------------------
If strPath & arrDirNames(i) = strStartDirName Then
ReDim arrFiles(1 To lFileCount) As String
For n = 1 To lFileCount
arrFiles(n) = collFiles(n)
Next
RecursiveFindFiles = arrFiles
Application.Cursor = xlDefault
Application.StatusBar = False
End If

Else 'If bSubFolders
ReDim arrFiles(1 To lFileCount) As String
For n = 1 To lFileCount
arrFiles(n) = collFiles(n)
Next
RecursiveFindFiles = arrFiles
Application.Cursor = xlDefault
Application.StatusBar = False
End If 'If bSubFolders

Exit Function
sysFileERR:

Resume sysFileERRCont1

End Function


Sub Test()

Dim arr
Dim lDirCount As Long
Dim lFileCount As Long

arr = RecursiveFindFiles("C:\", _
"*.*", _
False, _
True, _
lFileCount, _
lDirCount)

MsgBox lFileCount & " files found"

End Sub


RBS