'------------------------------------
'遍历列出所有目录
Public Function FindTxt(ByVal sTmp As String, list As Collection)
Dim myPath, myName As String
Dim i, j, k As Integer
Dim sPath() As String
Dim sStr() As String
Dim sTemp As String
'Dim sTxt() As String
myPath = sTmp
myName = Dir(myPath, vbDirectory) ' 找寻第一项。
j = 0
k = 0
While Len(myName) > 0
If myName <> "." And myName <> ".." Then
' 使用位比较来确定 MyName 代表一目录。
If (GetAttr(myPath & myName) And vbDirectory) = vbDirectory Then
ReDim Preserve sPath(j)
'Debug.Print "找到目录 " & myName ' 如果它是一个目录，将其名称显示出来。
sPath(j) = myName
'i = i + 1
j = j + 1
Else
sStr = Split(myName, ".")
If UBound(sStr) = 1 Then
If LCase(sStr(1)) = "txt" Then
'ReDim Preserve sTxt(k)
'Debug.Print "找到文件 " & myName ' 如果它是一个目录，将其名称显示出来。
list.Add myName
'sTxt(k) = myName
'k = k + 1
End If
End If
End If
End If
myName = Dir
Wend
If j > 0 Then
For i = 0 To UBound(sPath)
Call FindTxt(myPath & sPath(i) & "\", list)
Next
End If
Erase sPath
'Erase sTxt
End Function
