遍历文件夹

Sub 遍历文件夹()

'Columns(1).Delete

On Error Resume Next

Dim f As String

Dim file() As String

Dim i, k, x

x = 1

i = 1: k = 1

ReDim file(1 To i)

file(1) = InputBox("请输入要查找的文件夹：") & "\"

Do Until i > k

f = Dir(file(i), vbDirectory)

Do Until f = ""

If InStr(f, ".") = 0 Then

k = k + 1

ReDim Preserve file(1 To k)

file(k) = file(i) & f & "\"

End If

f = Dir

Loop

i = i + 1

Loop

For i = 1 To k

f = Dir(file(i) & "*m.xls*")

Do Until f = ""

'Range("a" & x) = f

Range("a" & x).Hyperlinks.Add anchor:=Range("a" & x), Address:= _

file(i) & f, TextToDisplay:=f

x = x + 1

f = Dir

Loop

Next

End Sub