- 帖子
- 228
- 主題
- 73
- 精華
- 2
- 積分
- 333
- 點名
- 0
- 作業系統
- Windows 10
- 軟體版本
- Office 2000, 2019
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 彰化縣
- 註冊時間
- 2013-7-18
- 最後登錄
- 2024-10-13
|
2#
發表於 2014-12-28 23:23
| 只看該作者
將以下代碼存成模組，用法請自行測試！我不知道適不適合！
Option Explicit
Option Base 1
Public 檔案資訊陣列() As String
Public Sub 搜尋檔案(ByVal 資料夾路徑 As String, ByVal 篩選檔名 As String, ByVal 包含子資料夾 As Boolean, Optional ByVal 子資料夾階層數 As Long = 255)
On Error Resume Next
Dim 階層序 As Long
Dim 階層數 As Long
Dim 目前階層資料夾序 As Long
Dim 目前階層資料夾數 As Long
Dim 下一階層資料夾數 As Long
Dim 檔案數 As Long
Dim 資料夾路徑陣列() As String
Dim 資料夾路徑陣列數 As Long
Dim 檔案資訊陣列數 As Long
Dim 資料夾或檔名 As String
Erase 檔案資訊陣列
If 包含子資料夾 = True Then
If 子資料夾階層數 < 1 Then
子資料夾階層數 = 1
ElseIf 子資料夾階層數 > 255 Then
子資料夾階層數 = 255
End If
階層數 = 1 + 子資料夾階層數
Else
階層數 = 1
End If
ReDim 資料夾路徑陣列(階層數, 1) As String
資料夾路徑陣列(1, 1) = 資料夾路徑 '資料夾路徑必須經過修正，結尾帶\
下一階層資料夾數 = 1
資料夾路徑陣列數 = 1
檔案數 = 0
檔案資訊陣列數 = 0
For 階層序 = 1 To 階層數
If Not 資料夾路徑陣列(階層序, 1) = "" Then
目前階層資料夾數 = 下一階層資料夾數
下一階層資料夾數 = 0
For 目前階層資料夾序 = 1 To 目前階層資料夾數
資料夾或檔名 = Dir(資料夾路徑陣列(階層序, 目前階層資料夾序) & "*", 31)
Do Until 資料夾或檔名 = ""
If Not 資料夾或檔名 = "." And Not 資料夾或檔名 = ".." Then
If (GetAttr(資料夾路徑陣列(階層序, 目前階層資料夾序) & 資料夾或檔名) And vbDirectory) = vbDirectory Then
If 階層序 < 階層數 Then
下一階層資料夾數 = 下一階層資料夾數 + 1
If 下一階層資料夾數 > 資料夾路徑陣列數 Then
資料夾路徑陣列數 = 資料夾路徑陣列數 + 99
ReDim Preserve 資料夾路徑陣列(階層數, 資料夾路徑陣列數) As String
End If
資料夾路徑陣列(階層序 + 1, 下一階層資料夾數) = 資料夾路徑陣列(階層序, 目前階層資料夾序) & 資料夾或檔名 & "\"
End If
Else
If 資料夾或檔名 Like 篩選檔名 Then
檔案數 = 檔案數 + 1
If 檔案數 > 檔案資訊陣列數 Then
檔案資訊陣列數 = 檔案資訊陣列數 + 999
ReDim Preserve 檔案資訊陣列(1, 檔案資訊陣列數) As String
End If
檔案資訊陣列(1, 檔案數) = 資料夾或檔名
End If
End If
End If
資料夾或檔名 = Dir
Loop
Next 目前階層資料夾序
Else
Exit For
End If
Next 階層序
ReDim Preserve 檔案資訊陣列(1, 檔案數) As String
End Sub |
|
發表於 2014-11-5 15:35
| 
