|
我写了一个查找文件的模块，不用API也能根据通配符实现递归查找某文件夹及其子文件夹下所有文件，包括所有隐藏、系统、只读文件，运行速度也快。并且可以同时匹配多个通配符，多个通配符以";"分隔即可。现共享给大家，希望能对大家有所帮助。
代码如下：
''''''''''''模块开始'''''
Option Explicit
'-- By 同济黄正 http://websamba.com/hzhzhz --'
Function GetAllSubFiles(ByVal strParentFolder As String, ByVal Patterns As String) As String
If strParentFolder = "" Then Exit Function
Screen.MousePointer = 11 '显示沙漏
If Right(strParentFolder, 1) <> "\" Then strParentFolder = strParentFolder & "\"
Dim Tem As String, Dirs As String, arrPatternsLCase() As String
Patterns = LCase(Patterns)
arrPatternsLCase = Split(Patterns, ";") '可同时进行多个匹配，多个匹配以";"分隔 Tem = Dir(strParentFolder, 63) '查找文件及文件夹,包含所有隐藏、系统、只读文件
Do Until Tem = ""
If GetAttr(strParentFolder & Tem) And vbDirectory Then '判断是否文件夹
If Tem <> "." And Tem <> ".." Then Dirs = Dirs & vbNullChar & strParentFolder & Tem & "\" '先将子文件夹名缓存在Dirs中
Else
If InStr(Tem, ".") = 0 Then Tem = Tem & "."
If IsPattern(Tem, arrPatternsLCase) Then GetAllSubFiles = GetAllSubFiles & vbNullChar & strParentFolder & Tem
End If
Tem = Dir() '查找下一个
Loop '--处理子文件夹
If Dirs <> "" Then
Dirs = Mid(Dirs, 2) '去除第一个vbNullChar
Dim I As Long
Dim arrSubFd() As String
arrSubFd = Split(Dirs, vbNullChar) '将子文件夹名分配到数组
For I = 0 To UBound(arrSubFd)
GetAllSubFiles = GetAllSubFiles & GetAllSubFiles(arrSubFd(I), Patterns) '递归子文件夹
Next
End If
Screen.MousePointer = 0
End Function Function IsPattern(ByVal strFileName As String, arrPatternsLCase() As String) As Boolean '判断是否匹配
Dim Pattern
For Each Pattern In arrPatternsLCase
If Pattern <> "" Then
If LCase(strFileName) Like Pattern Then IsPattern = True: Exit Function
End If
Next
End Function
'''''''模块结束''''''''''''
函数GetAllSubFiles返回一个用vbNullChar分隔的多个文件名的字符串(包含路径)，调用函数GetAllSubFiles即可的到某文件夹下所有匹配的文件名，接下来用Split函数可得到每一个文件名。
例如将文件名添加到ListBox的代码：
Dim FNs As String, arrFN() As String, FN
FNs = GetAllSubFiles("D:\music\", "*.mp3;*.wma") '列举D:\music\下的所有.mp3和.wma文件
arrFN = Split(FNs, vbNullChar)
For Each FN In arrFN
ListBox.AddItem FN
Next 以上代码均在WinXP/VB6下通过。
|
