不用API实现查找某文件夹下所有文件

    我写了一个查找文件的模块,不用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下通过。

  • 0
    点赞
  • 1
    收藏
    觉得还不错? 一键收藏
  • 0
    评论

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值