实现搜索所有文件和文件夹

就是在一个大文件夹下，搜索出包含某关键字的所有文件和文件夹。我自己用的.filesearch，.SearchFolders = True。但是这样只能把所有包含关键字的单个文件找出来，不能找出包含关键字的子文件夹。求高手指教应该怎么办。
这个大文件夹下面是有很多层子文件夹、文件的，用dir函数循环的话，路径怎么变化也是个问题，只好求助了。

在立即窗口中查看结果，搜索结果包括文件及文件夹，要复制的话，文件夹里的文件会重复复制，不明白你的意思
Sub test()
    FindFile "c:\abc\", "*目标*"
End Sub

Sub FindFile(mPath As String, Optional sFile As String = "")
On Error Resume Next
Dim s As String, sDir() As String
Dim i As Long, d As Long

If Right(mPath, 1) <> "\" Then
    mPath = mPath & "\"
End If
'查找目录下的文件
s = Dir(mPath & sFile, vbArchive + vbDirectory + vbHidden + vbNormal + vbReadOnly + vbSystem)
Do While s <> ""
   Debug.Print mPath & s
   s = Dir
Loop
'查找目录下的子目录
s = Dir(mPath, vbArchive + vbDirectory + vbHidden + vbNormal + vbReadOnly + vbSystem)
Do While s <> ""
    If s <> "." And s <> ".." Then
        If (GetAttr(mPath & s) And vbDirectory) = vbDirectory Then
        d = d + 1
        ReDim Preserve sDir(d)
        sDir(d) = mPath & s
        End If
    End If
    s = Dir
Loop

'开始递归
For i = 1 To d
    FindFile sDir(i) & "\", sFile
Next

End Sub

论坛币干嘛的

balance2050 发表于 2011-8-30 11:26
论坛币干嘛的

不知道，应该有用，我倾尽所有求助了

以下过程利用递归可以查找目录和子目录下的所有文件
Public Sub FindFile(mPath As String, Optional sFile As String = "")
On Error Resume Next
Dim s As String, sDir() As String
Dim i As Long, d As Long

If Right(mPath, 1) <> "\" Then
    mPath = mPath & "\"
End If
'查找目录下的文件
s = dir(mPath & sFile, vbArchive + vbDirectory + vbHidden + vbNormal + vbReadOnly + vbSystem)
Do While s <> ""
   Debug.Print mPath & s
   s = dir
Loop
'查找目录下的子目录
s = dir(mPath, vbArchive + vbDirectory + vbHidden + vbNormal + vbReadOnly + vbSystem)
Do While s <> ""
    If s <> "." And s <> ".." Then
        If (GetAttr(mPath & s) And vbDirectory) = vbDirectory Then
        d = d + 1
        ReDim Preserve sDir(d)
        sDir(d) = mPath & s
        End If
    End If
    s = dir
Loop

'开始递归        
For i = 1 To d
    FindFile sDir(d) & "\"
Next

End Sub

agstick 发表于 2011-8-30 14:21
以下过程利用递归可以查找目录和子目录下的所有文件
Public Sub FindFile(mPath As String, Optional sFil ...

我研究一下，比如我要在c:\abc\下查找所有含有“目标”的文件和文件夹，找出后在c:\下建立一名为“目标”的文件夹，并把搜索结果都复制到里面，应该怎么弄?

agstick 发表于 2011-8-30 16:24
在立即窗口中查看结果，搜索结果包括文件及文件夹，要复制的话，文件夹里的文件会重复复制，不明白你的意思 ...

我已经用你给的方法做好了，谢谢谢谢！！！

Dim MyFile, MyPath, MyName

' 返回“WIN.INI”(在 Microsoft Windows 中) （如果该文件存在）。
MyFile = Dir("C:\WINDOWS\WIN.ini")
                ' 返回带指定扩展名的文件名。如果超过一个 *.ini 文件存在，
' 函数将返回按条件第一个找到的文件名。
MyFile = Dir("C:\WINDOWS\*.ini")
                ' 若第二次调用 Dir 函数，但不带任何参数，则函数将返回同一目录下的下一个 *.ini 文件。
MyFile = Dir
                ' 返回找到的第一个隐式 *.TXT 文件。
MyFile = Dir("*.TXT", vbHidden)
                ' 显示 C:\ 目录下的名称。
MyPath = "c:\"    ' 指定路径。
MyName = Dir(MyPath, vbDirectory)
                ' 找寻第一项。
Do While MyName <> ""    ' 开始循环。
    ' 跳过当前的目录及上层目录。
    If MyName <> "." And MyName <> ".." Then
                        ' 使用位比较来确定 MyName 代表一目录。
        If (GetAttr(MyPath & MyName) And vbDirectory) = vbDirectory Then
                            Debug.Print MyName    ' 如果它是一个目录，将其名称显示出来。
        End If
                    End If
                    MyName = Dir    ' 查找下一个目录。
Loop