一般来说，搜寻目录及子目录底下符合条件之所有档案功能的程式撰写，一向颇令人头疼，而最後的解决方式多用 Recursive(程式递回呼叫) 来解决，像 VB5.0所附的 WinSeek.vbp 范例，就是 FileListBox 和 Recursive 程序的兼用，来解决这个问题。
本范例则用另一种思考模式切入，在不使用任何 OCX 及 Recursive 程序下利用两个非固定阵列变数及双层 Do...Loop 回圈解决这问题。本范例代表的含意是你把这段 Code 搬到无使用者可视界面的 Module 及 Class 里，一样可以执行(程式里的ListBox 及 MsgBox 只是为了解说方便而已，实际的资料已放入 FilePackage 这个动态阵列里，可以 Index 取用。)
当然你不能拿 Windows95 提供的[寻找]功能的搜寻速度来要求本范例，因为那根本是两种不同的驱动方式，但我用 "c:" 为搜寻启始目录，以 "*.*" 为条件来与 VB5.0 的范例程式 WinSeek.vbp 相比，WinSeek.vbp 是 2 分钟，我是 2.5 分钟。更值得一提的是，其实整个搜寻动作在 55 秒时已全部完成，剩下的时间都是用来显示 ListBox 资料。所以如果你的程式并不需要立即的显示查询结果，那麽本范例将比 WinSeek.vbp 更适合你使用。
最後如果你觉得本程式有任何错误或有改进的意见，请写信给站长，站长会转信给我，在此先谢谢你了。
Need a ListBox, CommandBox
Option Explicit
宣告搜寻到的档案的储存阵列变数
Private FilePackage() As String
Private Sub Command1_Click()
宣告存放目录名称储存阵列变数
Dim DirPackage() As String
存放档案搜寻条件之字串
Dim SearchString As String
接收 Dir() 传回字串，并做为回圈判断的字串
Dim DirString As String
I 目前搜寻目录的指位器，J 是 DirPackage 目录阵列之上限指标
K 是 FilePackage 之档案阵列之上限指标
Dim I As Long, J As Long, K As Long
把 ListBox 的旧显示资料清掉
List1.Clear
把 FilePackage 的上一次搜寻资料清掉
Erase FilePackage
假设我们的搜寻从 C 碟根目录开始
ReDim DirPackage(0)
路径结尾一定要加 ""
DirPackage(0) = "c:"
（本文来源于图老师网站，更多请访问http://m.tulaoshi.com/bianchengyuyan/）假设我们的搜寻字串是 "*.exe"
SearchString = .exe"
显示沙漏指标
Me.MousePointer = 11
-------- 以下搜寻 C 碟里所有的目录 -----------------
直到目录指位器 I 超过目录上限指标 J 才结束搜寻
Do While I $#@60;= J
搜寻目录指位器 I 所指的目录
DirString = Dir(DirPackage(I), vbHidden Or vbDirectory Or vbReadOnly Or vbSystem)
直到目前目录找不到任何目录或档案才结束
Do While DirString $#@60;$#@62; ""
不要把上层目录和现目录的指标符号算进去
If DirString $#@60;$#@62; "." And DirString $#@60;$#@62; ".." Then
如果找到的是个目录
If (GetAttr(DirPackage(I) & DirString) And vbDirectory) _
= vbDirectory Then
把目录上限加 1
J = J + 1
把储存目录名称的阵列加一个
ReDim Preserve DirPackage(J)
把查到的新目录放在 DirPackage 新元素里
DirPackage(J) = DirPackage(I) + DirString + ""
如果找到的是个档案
Else
如果与搜寻字串相符合
If UCase(DirString) Like UCase(SearchString) Then
把储存档案名称的阵列加一个
ReDim Preserve FilePackage(K)
把查到的新档案放在 filePackage 新元素里
FilePackage(K) = DirPackage(I) + DirString
把档案上限加 1
K = K + 1
End If
End If
End If
继续找是否有符合的资料，并把结果放 DirString 里
（本文来源于图老师网站，更多请访问http://m.tulaoshi.com/bianchengyuyan/）DirString = Dir
DoEvents
Loop
把现目录指标往下移一个
I = I + 1
Loop
-------- 以下将结果输出到列示盒里 -----------------
-------- 以下为找到档案之总计 -----------------
还原滑鼠指标
Me.MousePointer = 0If K = 0 ThenMsgBox "没有 " & SearchString & " 的档案"Else
以下将结果输出到列示盒里
For I = 0 To UBound(FilePackage)List1.AddItem FilePackage(I)DoEventsNextMsgBox "总共找到 " & UBound(FilePackage) + 1 & " 个档案"End IfEnd Sub
以下有Recursive作法，本人测试发现Recursive的作法略快一些，原因可能出在ReDim Preserve DirPackage与 ReDim Preserve sDirectoryList上，前者一直动态新增目录字串(如果c:之下含目录下的子目录一共100个，那这个阵列便会有100的大小)，而後者Recursive的作法则不同，它动态目录的最大值则是含有最大子目录数的那个目录中，子目录之数目(如：c:windows中含最多子目录，其子目录有30个，且这30个是不含子目录下的子目录，则动态字串阵列的最大个数便只有30)
Need a CommandBoxPrivate FoundFile() as String 存放传回值的字串阵列Private ntx As LongPrivate Sub Command1_Click()ntx = 0Call GetDirPath("c:", "*.ini")End SubPrivate Sub GetDirPath(CurrentPath As String, ByVal SearFile As String)Dim nI As Integer, nDirectory As Integer, i As LongDim sFileName As String, sDirectoryList() As StringFirst list all normal files in this directorysFileName = Dir(CurrentPath, vbHidden Or vbDirectory Or vbReadOnly Or vbSystem)Do While sFileName $#@60;$#@62; ""If UCase(sFileName) Like UCase(SearFile) Theni = GetAttr(CurrentPath + sFileName)If (i And vbDirectory) = 0 ThenReDim Preserve FoundFile(ntx)FoundFile(ntx) = CurrentPath + sFileNamentx = ntx + 1End IfEnd IfIf sFileName $#@60;$#@62; "." And sFileName $#@60;$#@62; ".." ThenIgnore nondirectoriesIf GetAttr(CurrentPath & sFileName) _And vbDirectory ThennDirectory = nDirectory + 1ReDim Preserve sDirectoryList(nDirectory)sDirectoryList(nDirectory) = CurrentPath & sFileNameEnd IfEnd IfsFileName = DirLoopRecursively process each directoryFor nI = 1 To nDirectoryGetDirPath sDirectoryList(nI) & "", SearFileNext nIEnd Sub 
