Sub GetAllFiles()
Dim pth$, arr, i%, r%, hlink
With Application.FileDialog(msoFileDialogFolderPicker)
  If .Show = -1 Then
    pth = .SelectedItems(1)
  Else
    MsgBox "ÄúûÓÐÑ¡ÔñÈκÎÎļþ¼Ð£¡", vbCritical: Exit Sub
  End If
End With
ReDim arr(1 To 6, 1 To 1)
arr(1, 1) = "ÎļþÃû³Æ"
arr(2, 1) = "ÎļþλÖÃ"
arr(3, 1) = "´´½¨ÈÕÆÚ"
arr(4, 1) = "ÐÞ¸ÄÈÕÆÚ"
arr(5, 1) = "ÎļþÀàÐÍ"
arr(6, 1) = "Îļþ´óС"
Getfd pth, arr
arr = Application.WorksheetFunction.Transpose(arr)    'ÎļþÐÅÏ¢Òѱ£´æÔÚarrÊý×éÖÐ
'ʵ¼ÊʹÓÃʱ¿É²»Êä³öµ½¹¤×÷±í£¬Ö±½ÓÔÚÊý×éarrÖвéѯÐèÒªµÄÎļþÐÅÏ¢¡£ÒÔÏÂ10ÐпÉɾ³ý
For i = 2 To UBound(arr)
  hlink = arr(i, 2)
  arr(i, 1) = "=hyperlink(""" & hlink & """,""" & arr(i, 1) & """)"
  arr(i, 2) = "=hyperlink(""" & hlink & """,""" & hlink & """)"
Next i
Application.ScreenUpdating = False
With ActiveSheet
  .UsedRange.Clear
  .Cells(1, 1).Resize(UBound(arr, 1), UBound(arr, 2)) = arr
  r = .Range("a" & Rows.Count).End(3).Row
  .Range("a1:f" & r).Borders.LineStyle = xlContinuous
  .Range("a1:f" & r).Borders.Weight = xlThin
End With
Application.ScreenUpdating = True
[a1].CurrentRegion.AutoFilter Field:=1    'Êä³ö½á¹ûµ½¹¤×÷±í£¬²¢ÆôÓÃɸѡģʽ
MsgBox "ÎļþÒÑÈ«²¿»ñÈ¡£¡µã¡ºÈ·¶¨¡»¼ü½áÊø"
End Sub