Sub Macro1()
Dim Fso As Object, Folder As Object
Dim arrf$(), mf&, i&
Set Fso = CreateObject("Scripting.FileSystemObject")
Set Folder = Fso.GetFolder(ThisWorkbook.Path)
Call GetFiles(Folder, arrf, mf)
ReDim brr(1 To mf, 1 To 3)
[a1].CurrentRegion.Offset(1).ClearContents
With ActiveSheet
For i = 1 To mf
brr(i, 1) = arrf(1, i)
brr(i, 3) = arrf(1, i)
.Hyperlinks.Add Anchor:=Cells(i + 1, 3), Address:=arrf(2, i)
Next
End With
[a2].Resize(mf, 3) = brr
Set Folder = Nothing
Set Fso = Nothing
Application.ScreenUpdating = True
End Sub
Sub GetFiles(ByVal Folder As Object, ByRef arrf$(), ByRef mf&)
Dim SubFolder As Object
Dim File As Object
For Each File In Folder.Files
If https://www.doczj.com/doc/322257537.html, Like "*.xls*" Then
If InStr(https://www.doczj.com/doc/322257537.html,, https://www.doczj.com/doc/322257537.html,) = 0 Then
mf = mf + 1
ReDim Preserve arrf(1 To 2, 1 To mf)
arrf(1, mf) = https://www.doczj.com/doc/322257537.html,
arrf(2, mf) = File
End If
End If
Next
For Each SubFolder In Folder.SubFolders
Call GetFiles(SubFolder, arrf, mf)
Next
End Sub