具有子目录的最佳findfile
我一直在寻找，找不到一种方法来搜索一个文件，其中包括子目录。Excel有一个. FileSearch方法，但是那没有帮助有什么想法？
**** Hidden Message ***** 没有检查每个目录中的其他目录，然后检查它们，我不确定。 最好？当然不是，这是我大约一百年前写的（不要笑）。滥用你认为合适的。
Option Explicit
Public Sub Test ( )
Dim foldername As String, _
filespec As String, _
var As Variant
foldername = "c:\windows\temp"
''you could use this to reduce the initial scan results
filespec = "*.*"
''in a real world app you'd want to set the result to a collection
''and then test the count before attempting to iterate it
For Each var In GetAllFiles(foldername, filespec, True)
Debug.Print var
''do your final file matching code here if filespec doesn't nail it
Next var
End Sub
Public Function GetAllFiles(foldername As String, filespec As String, recurse As Boolean) As Collection
Dim result As New Collection
Call GetAllFilesEx(foldername, filespec, recurse, result)
Set GetAllFiles = result
End Function
Private Sub GetAllFilesEx(foldername As String, _
filespec As String, _
recurse As Boolean, _
ByRef result As Collection)
DoEvents
Dim filename As String, _
fullname As String, _
folder As Variant, _
foldersAs New Collection
If recurse Then
''get any folders
filename = Dir$(foldername & "\*.*", vbDirectory)
Do While filename""
If filename = "." Then GoTo Iterate
If filename = ".." Then GoTo Iterate
fullname = foldername & "\" & filename
If GetAttr(fullname) And vbDirectory Then
folders.Add fullname
End If
Iterate:
filename = Dir$
Loop
End If
''get the files
filename = Dir$(foldername & "\" & filespec, vbHidden)
Do While filename""
fullname = foldername & "\" & filename
result.Add fullname
filename = Dir$
Loop
For Each folder In folders
Call GetAllFilesEx(CStr(folder), filespec, recurse, result)
Next folder
End Sub
编辑：修复了一个错字。 谢谢，我会看看能不能做到的
我时不时地发布以下模块。它使用api调用，所以它的速度更快一些，只允许搜索某些filenanme扩展名，并在模块的末尾包含一个子例程，每次找到一个指定的文件时都会调用该子例程，因此您可以执行诸如OPEN a *.dwg，PRINT a *.txt等操作
Option Explicit
Private Const vbDot = 46
Private Const MAX_PATH As Long = 260
Private Const INVALID_HANDLE_VALUE = -1
Private Const vbBackslash = "\"
Private Const ALL_FILES = "*.*"
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 lstrlen Lib "kernel32" _
Alias "lstrlenW" (ByVal lpString As Long) As Long
Private Declare Function PathMatchSpec Lib "shlwapi" _
Alias "PathMatchSpecW" (ByVal pszFileParam As Long, _
ByVal pszSpec As Long) As Long
Dim sFileExt As String
Dim sFileRoot As String
Public Sub FindAllFiles(FileType As String, StartPath As String)
' recursively searches a passed path for files of a given type
' FileType: a wildcard string of the file extension, ie; "*.dwg" or "*.xls"
' calls "DoSomethingWithFile" subroutine to execute your own code on each found file
sFileRoot = QualifyPath(StartPath) 'start path
sFileExt = FileType 'file type of interest
Call SearchForFiles(sFileRoot)
End Sub
Private Sub SearchForFiles(sRoot As String)
Dim WFD As WIN32_FIND_DATA
Dim hFile As Long
hFile = FindFirstFile(sRoot & ALL_FILES, WFD)
If hFileINVALID_HANDLE_VALUE Then
Do
'if a folder, and recurse specified, call method again
If (WFD.dwFileAttributes And vbDirectory) Then
If Asc(WFD.cFileName)vbDot Then
SearchForFiles sRoot & TrimNull(WFD.cFileName) & vbBackslash
End If
Else
'must be a file..
If MatchSpec(WFD.cFileName, sFileExt) Then
DoSomethingWithFile sRoot & TrimNull(WFD.cFileName)
End If 'If MatchSpec
End If 'If WFD.dwFileAttributes
Loop While FindNextFile(hFile, WFD)
End If 'If hFile
Call FindClose(hFile)
End Sub
Private Function QualifyPath(sPath As String) As String
' formats passed path string to be used in recursive API search
If Right$(sPath, 1)vbBackslash Then
QualifyPath = sPath & vbBackslash
Else
QualifyPath = sPath
End If
End Function
Private Function TrimNull(startstr As String) As String
' trims NULL char (ascii 0) from strings returned by API calls
TrimNull = Left$(startstr, lstrlen(StrPtr(startstr)))
End Function
Private Function MatchSpec(sFile As String, sSpec As String) As Boolean
' uses API version of the "LIKE" command
MatchSpec = PathMatchSpec(StrPtr(sFile), StrPtr(sSpec))
End Function
Private Sub DoSomethingWithFile(FoundFileName As String)
' use this routine to do something with each file found
' we'll do nothing but print out the filename found
Dim FoundName As String: FoundName = FoundFileName
Debug.Print FoundName
End Sub
页:
[1]