VB and VBA Users Source Code: Perform a recursive search for a file or pattern using API
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
Perform a recursive search for a file or pattern using API
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Monday, February 19, 2001
Hits:
1010
Category:
Windows API
Article:
Below is a routine to perform a recursive search for all the matching files in a directory using windows API calls. A demonstration routine can be found at the bottom of this post. Option Explicit Private Const MAX_PATH As Long = 260 Private Const INVALID_HANDLE_VALUE As Long = -1 Private Const FILE_ATTRIBUTE_ARCHIVE As Long = &H20 Private Const FILE_ATTRIBUTE_COMPRESSED As Long = &H800 Private Const FILE_ATTRIBUTE_DIRECTORY As Long = &H10 Private Const FILE_ATTRIBUTE_HIDDEN As Long = &H2 Private Const FILE_ATTRIBUTE_NORMAL As Long = &H80 Private Const FILE_ATTRIBUTE_READONLY As Long = &H1 Private Const FILE_ATTRIBUTE_TEMPORARY As Long = &H100 Private Const FILE_ATTRIBUTE_FLAGS = FILE_ATTRIBUTE_ARCHIVE Or FILE_ATTRIBUTE_HIDDEN Or FILE_ATTRIBUTE_NORMAL Or FILE_ATTRIBUTE_READONLY 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 Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long 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 SearchTreeForFile Lib "imagehlp.dll" (ByVal sFileRoot As String, ByVal InputPathName As String, ByVal OutputPathBuffer As String) As Boolean 'Purpose : Performs a recursive search for a file or file pattern. 'Inputs : asMatchingFiles See outputs. ' sRootPath The path to begin the search from eg. "C:\" ' sSearchFor The file name or pattern to search for eg. "Test.xls" or "*.xls" ' bRecursiveSearch If True searchs all subfolders in sRootPath for matching files. 'Outputs : asMatchingFiles A one based, 1d string array containing the paths and names of ' the matching files. SEE NOTES. ' Returns the number of matching files. 'Author : Andrew Baker 'Date : 02/10/2000 15:11 'Notes : Example: ' FileSearch asFiles, "C:\", "*.ocx", True 'Populates asFiles with all the .ocx files on your C: drive 'Revisions : Function FileSearch(ByRef asMatchingFiles() As String, ByVal sRootPath As String, sSearchFor As String, Optional bRecursiveSearch As Boolean = True) As Long Dim tFindFile As WIN32_FIND_DATA Dim lNumFound As Long, lHwndFile As Long Dim sItemName As String, sThisPath As String Dim asDirs() As String, lNumDirs As Long, lThisDir As Long Static sbRecursion As Boolean On Error Resume Next If sbRecursion = False Then 'Clear existing list Erase asMatchingFiles End If If Right$(sRootPath, 1) <> "\" Then sRootPath = sRootPath & "\" End If lNumFound = UBound(asMatchingFiles) 'Get handle to folder lHwndFile = FindFirstFile(sRootPath & "*", tFindFile) If lHwndFile <> INVALID_HANDLE_VALUE Then '-------Found a matching file, loop over other matching files Do If (tFindFile.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) Then sItemName = Left$(tFindFile.cFileName, InStr(1, tFindFile.cFileName, vbNullChar) - 1) 'Check directory name is valid If sItemName <> "." And sItemName <> ".." Then 'Store directory lNumDirs = lNumDirs + 1 If lNumDirs = 1 Then ReDim asDirs(1 To lNumDirs) Else ReDim Preserve asDirs(1 To lNumDirs) End If sThisPath = sRootPath & sItemName asDirs(lNumDirs) = sThisPath End If Else 'Found file sItemName = Left$(tFindFile.cFileName, InStr(1, tFindFile.cFileName, vbNullChar) - 1) If sItemName Like sSearchFor Then 'Found matching file lNumFound = lNumFound + 1 If lNumFound = 1 Then ReDim asMatchingFiles(1 To 1) Else ReDim Preserve asMatchingFiles(1 To lNumFound) End If asMatchingFiles(lNumFound) = sRootPath & sItemName End If End If Loop While FindNextFile(lHwndFile, tFindFile) 'Close find handle lHwndFile = FindClose(lHwndFile) If bRecursiveSearch Then '-----------Loop over folders For lThisDir = 1 To lNumDirs 'Item is a folder, search subfolders for matching files sThisPath = asDirs(lThisDir) sbRecursion = True FileSearch asMatchingFiles, sThisPath, sSearchFor, bRecursiveSearch sbRecursion = False Next End If End If FileSearch = UBound(asMatchingFiles) End Function 'Demonstration routine Sub Test() Dim asFiles() As String, lThisFile As Long, lNumFiles As Long '---Find all DLLs on C Drive, warning this may take a while!!! lNumFiles = FileSearch(asFiles, "C:\Winnt", "*.dll", True) For lThisFile = 1 To lNumFiles Debug.Print asFiles(lThisFile) Next '---Find all XLS files on C Drive, warning this may take a while!!! lNumFiles = FileSearch(asFiles, "C:\program files\", "*.xls", True) For lThisFile = 1 To lNumFiles Debug.Print asFiles(lThisFile) Next End Sub
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
