|
'dir不用递归可以的,而且效率不一定差,,,
Option Explicit
Sub test()
Dim filename(1 To 10 ^ 4, 1 To 1) As String, m As Long
Call getfilename(filename, ThisWorkbook.Path, ".xlsx", m)
With [a:a]
.ClearContents
If m > 0 Then .Resize(m) = filename
End With
End Sub
Function getfilename(filename, pth As String, mark As String, m)
Dim f, cnt As Long, p(10 ^ 5) As String
If Right(pth, 1) <> "\" Then pth = pth & "\"
Do
f = Dir(pth, vbDirectory)
Do While Len(f) > 0
If f <> "." And f <> ".." Then
If (GetAttr(pth & f) And vbDirectory) = vbDirectory Then
cnt = cnt + 1: p(cnt) = pth & f & "\"
Else
' If LCase(Right(f, Len(mark))) = LCase(mark) Then
m = m + 1
filename(m, 1) = pth & f
' End If
End If
End If
f = Dir
Loop
If cnt = 0 Then Exit Do
pth = p(cnt): cnt = cnt - 1
Loop
End Function |
评分
-
3
查看全部评分
-
|