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:\"
'假设我们的搜寻字串是 "*.exe" SearchString = "*.exe"
'显示沙漏指标 Me.MousePointer = 11
'-------- 以下搜寻 C 碟里所有的目录 -----------------
'直到目录指位器 I 超过目录上限指标 J 才结束搜寻 Do While I <= J
'搜寻目录指位器 I 所指的目录 DirString = Dir(DirPackage(I), vbHidden Or vbDirectory Or vbReadOnly Or vbSystem)
'直到目前目录找不到任何目录或档案才结束 Do While DirString <> ""
'不要把上层目录和现目录的指标符号算进去 If DirString <> "." And DirString <> ".." Then
'如果找到的是个档案 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 里 DirString = Dir DoEvents Loop
'把现目录指标往下移一个 I = I + 1 Loop
'-------- 以下将结果输出到列示盒里 -----------------
'-------- 以下为找到档案之总计 -----------------
'还原滑鼠指标 Me.MousePointer = 0
If K = 0 Then MsgBox "没有 " & SearchString & " 的档案" Else '以下将结果输出到列示盒里 For I = 0 To UBound(FilePackage) List1.AddItem FilePackage(I) DoEvents Next
' Need a CommandBox Private FoundFile() as String '存放传回值的字串阵列 Private ntx As Long
Private Sub Command1_Click() ntx = 0 Call GetDirPath("c:\", "*.ini") End Sub
Private Sub GetDirPath(CurrentPath As String, ByVal SearFile As String) Dim nI As Integer, nDirectory As Integer, i As Long Dim sFileName As String, sDirectoryList() As String 'First list all normal files in this directory sFileName = Dir(CurrentPath, vbHidden Or vbDirectory Or vbReadOnly Or vbSystem) Do While sFileName <> "" If UCase(sFileName) Like UCase(SearFile) Then i = GetAttr(CurrentPath + sFileName) If (i And vbDirectory) = 0 Then ReDim Preserve FoundFile(ntx) FoundFile(ntx) = CurrentPath + sFileName ntx = ntx + 1 End If End If If sFileName <> "." And sFileName <> ".." Then 'Ignore nondirectories If GetAttr(CurrentPath & sFileName) _ And vbDirectory Then
nDirectory = nDirectory + 1 ReDim Preserve sDirectoryList(nDirectory) sDirectoryList(nDirectory) = CurrentPath & sFileName End If End If sFileName = Dir Loop 'Recursively process each directory For nI = 1 To nDirectory GetDirPath sDirectoryList(nI) & "\", SearFile Next nI End Sub