7,759
社区成员
发帖
与我相关
我的任务
分享
Private Sub Command1_Click()
Dim aay() As String
Call SeachFile(aay, "e:\vbAPI\", "*.txt,*.gif")
Dim i As Integer
For i = 1 To UBound(aay)
Debug.Print aay(i)
Next
End Sub
'==================================================
'搜索文件子过程
Sub SeachFile(Ay() As String, ByVal Path As String, _
Optional ByVal strSc As String = "")
'Ay():返回所有符合搜索条件的文件,Ay(0)不是,从Ay(1)开始
'path:搜索路径
'strSc:搜索条件,用逗号分开,比如 "*.txt,win*.*"
'====================================================
Static scType() As String '搜索条件字串
Dim i As Long
DoEvents
On Error Resume Next
'初始化
If strSc <> "" Then
scType = Split(Trim(strSc), ",")
ReDim Preserve Ay(0)
End If
If Right(Path, 1) <> "\" Then Path = Path & "\"
'对当前的目录进行文件搜索
For i = 0 To UBound(scType)
Ay(0) = Dir(Path & scType(i), vbNormal Or vbReadOnly Or vbHidden)
Do While Ay(0) <> ""
ReDim Preserve Ay(1 + UBound(Ay))
Ay(UBound(Ay)) = Path & Ay(0)
Ay(0) = Dir
Loop
Next
'列举出所有子目录
Dim subPath() As String '存放子目录数组
ReDim subPath(0)
subPath(0) = Dir(Path, vbDirectory)
Do While subPath(0) <> ""
'去掉当前目录,和上级目录
If subPath(0) <> "." And subPath(0) <> ".." Then
'判断是否是目录
If (GetAttr(Path & subPath(0)) And vbDirectory) = vbDirectory Then
ReDim Preserve subPath(1 + UBound(subPath))
subPath(UBound(subPath)) = Path & subPath(0)
End If
End If
subPath(0) = Dir
Loop
'如果有子目录的话,进行递归
If UBound(subPath) > 0 Then
For i = 1 To UBound(subPath)
Call SeachFile(Ay, subPath(i))
Next
End If
End Sub
'删除空目录
ElseIf fsoFolder.Files.Count = 0 Then
fsoFolder.Delete
End If
Sub DeleteEmptyFolders(ByVal recentlyPath As String)
'''''''''''''''''''''''''''''''''''''''''''''''
'删除指定目录下的所有目录.
'recentlyPath参数:指定目录
'''''''''''''''''''''''''''''''''''''''''''''''
Dim fsoFolder As Folder '一个由recentlyPath指定的目录对象
Dim fsoI As Folder
Dim Fso As FileSystemObject '文件系统对象
Set Fso = New FileSystemObject
'交出控制权,及除错
DoEvents
On Error Resume Next
'如果目录不存在的话,退出子过程
If Not Fso.FolderExists(recentlyPath) Then Exit Sub
Set fsoFolder = Fso.GetFolder(recentlyPath) '创建一个folder
'对所有的子目录递归
If fsoFolder.SubFolders.Count > 0 Then
For Each fsoI In fsoFolder.SubFolders
DeleteEmptyFolders fsoI.Path '递归
Next
'删除空目录
ElseIf fsoFolder.SubFolders.Count = 0 Then
fsoFolder.Delete
End If
End Sub