Dim?MyName,?Dic,?Did,?I,?T,?F,?TT,?MyFileName
T?=?Time
Set?Dic?=?CreateObject("Scripting.Dictionary")'創建壹個字典對象
Set?Did?=?CreateObject("Scripting.Dictionary")
Dic.Add?("D:\My?Documents\"),?""
I?=?0
Do?While?I?<?Dic.Count
Ke?=?Dic.keys'開始遍歷字典
MyName?=?Dir(Ke(I),?vbDirectory)'查找目錄
Do?While?MyName?<>?""
If?MyName?<>?"."?And?MyName?<>?".."?Then
If?(GetAttr(Ke(I)?&?MyName)?And?vbDirectory)?=?vbDirectory?Then'如果是次級目錄
Dic.Add?(Ke(I)?&?MyName?&?"\"),?""?'就往字典中添加這個次級目錄名作為壹個條目
End?If
End?If
MyName?=?Dir'繼續遍歷尋找
Loop
I?=?I?+?1
Loop
Did.Add?("文件清單"),?""'以查找D盤My?Documents下所有EXCEL文件為例
For?Each?Ke?In?Dic.keys
MyFileName?=?Dir(Ke?&?"*.xls")
Do?While?MyFileName?<>?""
Did.Add?(Ke?&?MyFileName),?""
MyFileName?=?Dir
Loop
Next
For?Each?Sh?In?ThisWorkbook.Worksheets
If?Sh.Name?=?"XLS文件清單"?Then
Sheets("XLS文件清單").Cells.Delete
F?=?True
Exit?For
Else
F?=?False
End?If
Next
If?Not?F?Then
Sheets.Add.Name?=?"XLS文件清單"
End?If
Sheets("XLS文件清單").[A1].Resize(Did.Count,?1)?=?WorksheetFunction.Transpose(Did.keys)
TT?=?Time?-?T
MsgBox?Minute(TT)?&?"分"?&?Second(TT)?&?"秒"
End?Sub