查找函数:Private Function FindFile(ByVal Spath As String, GetFileName() As String, ByVal FindFileName As String) As LongDim Files(2) As Long '定义一个固定数组,保存匹配的文件(夹)名称,总数Dim SubDirs() As String '定义一个动态数组,,保存当前查找目录中的所有下级子目录(用来递归查找)Dim fos As New FileSystemObject, fol As FolderDim subfil, subfolIf Trim(Spath)="" Or FindFileName="" Then Exit Function'要查找的路径没带一"\",则添上一"\"If Right(Spath, 1) <> "\" Then Spath = Spath + "\"BeginFind:On Error Goto ExitSubSet fol = fos.GetFolder(Spath)For Each subfil In fol.Files If subfil.Name Like FindFileName Then Files(0) = Files(0) + 1 ReDim Preserve GetFileName(1 To Files(0)) GetFileName(Files(0)) = Spath & subfil.Name 'GetFileName这个数组返回匹配的所有文件(夹)名称,从参数中返回 End IfNextFor Each subfol In fol.SubFolders If subfol.Name Like FindFileName Then Files(0) = Files(0) + 1 ReDim Preserve GetFileName(1 To Files(0)) GetFileName(Files(0)) = Spath & subfol.Name End If Files(1) = Files(1) + 1 ReDim Preserve SubDirs(1 To Files(1)) SubDirs(Files(1)) = Spath & subfol.Name + "\" NextFiles(2) = Files(2) + 1 If Files(1) <> 0 And Files(2) <= Files(1) Then '如果有下级目录,且循环不大于子目录总数,则递归查找 Spath = SubDirs(Files(2)) GoTo BeginFindEnd IfFindFile = Files(0) '数组本身返回找到的总数Set fos = NothingExitSub:End Function调用:Private Sub Command1_Click()Dim GetName() As String '定义一个空的动态数组,接收返回的匹配文件名Dim FileCount As LongFileCount = FindFile("c:\a", GetName(), "a")Print "共找到"; FileCount; "个匹配的对象"For i = 1 To FileCount Print GetName(i) '显示出各个名称(包括路径)NextRedim GetName(0)End sub能用vb自带的函数、方法解决的,不想去用api,感觉查找速度跟使用api函数遍历目录的方法没什么差别。如果有什么地方可以改进的,请不吝指点,先行谢过!! 没有一个人不是平凡人,也没有一个人注定平庸

评论