Application.FileSearch vs. Dir

[Tim Peterson]

Is there any way to get FileSearch to function on XP or is
there any way to get Dir to search sub folders?

I recently developed and tested a application using Access
97 / Win98. The application crashes in WinXP when it
executes FileSearch. Knowlege Base Article 259738 says
that FileSearch may fail on a Windows 2000-based computer
and suggests using Dir (Does this article apply to XP?).
I posted an earlier thread in various groups and the
replies generally suggested that I check references on
both workstations. I did this, and the references checked
in checkboxes are the same on both. I rewrote the
procedure using Dir instead of FileSearch, and it works
fine except that files in subfolders are not returned as
with FileSearch.SearchSubFolders = True.

Is there any way to get FileSearch to function on XP or is
there any way to get Dir to search sub folders?

Tim Peterson

 

[Pieter Wijnen]

'------------- code to search subfolders -----------------------------

Option Compare Database
Option Explicit
Private Declare Function FindFirstFile Lib "Kernel32" Alias "FindFirstFileA"
(ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "Kernel32" Alias "FindNextFileA"
(ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function GetFileAttributes Lib "Kernel32" Alias
"GetFileAttributesA" (ByVal lpFileName As String) As Long
Private Declare Function FindClose Lib "Kernel32" (ByVal hFindFile As Long)
As Long

Private Const MAX_PATH = 260
Private Const MAXDWORD = &HFFFF
Private Const INVALID_HANDLE_VALUE = -1
Private Const FILE_ATTRIBUTE_ARCHIVE = &H20
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Const FILE_ATTRIBUTE_HIDDEN = &H2
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_ATTRIBUTE_READONLY = &H1
Private Const FILE_ATTRIBUTE_SYSTEM = &H4
Private Const FILE_ATTRIBUTE_TEMPORARY = &H100
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
Public Function FindFiles(Path As String, SearchStr As String, Files() As
String, FileCount As Long, DirCount As Long, Optional ByVal Recurse As
Boolean = True) As Double
Dim FileName As String ' Walking filename variable...
Dim DirName As String ' SubDirectory Name
Dim DirNames() As String 'Buffer for directory name entries
Dim TotalSize As Double
Dim nDir As Long ' Number of directories in this path
Dim i As Long ' For-loop counter...
Dim hSearch As Long ' Search Handle
Dim WFD As WIN32_FIND_DATA
Dim Cont As Long
Const CUR_DIR = "."
Const PAR_DIR = ".."
If Right(Path, 1) <> "\" Then Path = Path & "\" ' Search for
subdirectories.
nDir = 0
SysCmd Access.acSysCmdSetStatus, "Searching '" & Path & "' Please Wait .."
ReDim DirNames(nDir)
ReDim Preserve Files(FileCount)
Cont = True
hSearch = FindFirstFile(Path & "*", WFD)
If hSearch <> INVALID_HANDLE_VALUE Then
While Cont
DirName = WFD.cFileName
i = VBA.InStr(DirName, vbNullChar)
If i Then DirName = VBA.Left(DirName, i - 1) ' Ignore the current and
encompassing directories.
If (DirName <> CUR_DIR) And (DirName <> PAR_DIR) Then ' Check for
directory with bitwise comparison.
If (GetFileAttributes(Path & DirName) And FILE_ATTRIBUTE_DIRECTORY)
And Recurse Then
DirNames(nDir) = DirName
DirCount = DirCount + 1
nDir = nDir + 1
ReDim Preserve DirNames(nDir)
End If
End If
Cont = FindNextFile(hSearch, WFD) ' Get next subdirectory. Loop
Wend
Cont = FindClose(hSearch)
End If ' Walk through this directory and sum file sizes.
hSearch = FindFirstFile(Path & SearchStr, WFD)
Cont = True
If hSearch <> INVALID_HANDLE_VALUE Then
While Cont
FileName = WFD.cFileName
i = VBA.InStr(FileName, vbNullChar)
If i Then FileName = VBA.Left(FileName, i - 1) ' Ignore the current
and encompassing directories.
If Not (GetFileAttributes(FileName) And FILE_ATTRIBUTE_DIRECTORY) Then
TotalSize = TotalSize + (WFD.nFileSizeHigh * MAXDWORD) +
WFD.nFileSizeLow
Files(FileCount) = Path & FileName
FileCount = FileCount + 1
ReDim Preserve Files(FileCount)
'List1.AddItem path & FileName
End If
Cont = FindNextFile(hSearch, WFD) ' Get Next file
Wend
Cont = FindClose(hSearch)
End If ' If there are sub-directories...
If nDir > 0 And Recurse Then ' Recursively walk into them...
For i = 0 To nDir - 1
TotalSize = TotalSize + FindFiles(Path & DirNames(i) & "\", SearchStr,
Files, FileCount, DirCount, True)
Next i
End If
SysCmd Access.acSysCmdClearStatus
FindFiles = TotalSize
End Function
'------------- code to search subfolders -----------------------------

HTH

Pieter

 

[Albert D. Kallal]

You can always grab all files and sub folders into a collecon, and then work
with that.

Here is a sample rouinte I use to grab all files and files in 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