Code:
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