请参考
Sub test()
With Application.FileDialog(msoFileDialogFolderPicker)
MsgBox "请选择文件夹", 48, "温馨提示!"
If .Show = -1 Then '选择文件夹
mp = .SelectedItems(1) & "\" '您选择文件夹路径
End If
End With
mf = Dir(mp & "*.xlsx")
Set sht = ThisWorkbook.Sheets(1)
sht.Range("a1:a10000").Clear
Do
i = i + 1
Cells(i, 1).Value = mf
sht.Hyperlinks.Add anchor:=sht.Cells(i, 1), Address:=mp & mf, TextToDisplay:=Left(mf, Len(mf) - 5)
mf = Dir
Loop While mf <> ""
MsgBox "完毕!", 48, "温馨提示!"
sht.Activate
ThisWorkbook.Save
End Sub |