遍历本地文件夹并建立超链接

​

Sub QQ1722187970()

Dim i

Dim sPath

sPath = GetPath

If Len(sPath) Then

Dim oWK As Worksheet

Set oWK = ActiveSheet

oWK.Cells.Clear

'定义一个FileSystemObject对象

Dim oFso As Object

Set oFso = CreateObject("Scripting.FileSystemObject")

'定义一个文件夹对象

Dim oFolder As Object

Set oFolder = oFso.GetFolder(sPath)

'定义文件对象

Dim oFile As Object

'如果指定的文件夹含有文件

If oFolder.Files.Count Then

For Each oFile In oFolder.Files

'在活动单元格的A列创建对文件夹中的所有文件的超链接

With oWK

.Hyperlinks.Add anchor:=.Cells(1 + i, 1), Address:=oFile.Path, TextToDisplay:=oFile.Name

End With

i = i + 1

Next

End If

Else

MsgBox "你没有选择文件夹"

End If

End Sub

Function GetPath() As String

'声明一个FileDialog对象变量

Dim oFD As FileDialog

Dim oFDFilter As FileDialogFilters

'    '创建一个选择文件对话框

'    Set oFD = Application.FileDialog(msoFileDialogFilePicker)

'创建一个选择文件夹对话框

Set oFD = Application.FileDialog(msoFileDialogFolderPicker)

'声明一个变量用来存储选择的文件名

Dim vrtSelectedItem As Variant

With oFD

'允许选择多个文件

.AllowMultiSelect = True

'使用Show方法显示对话框，如果单击了确定按钮则返回-1。

If .Show = -1 Then

'遍历所有选择的文件

For Each vrtSelectedItem In .SelectedItems

'获取所有选择的文件的完整路径,用于各种操作

GetPath = vrtSelectedItem

Next

'如果单击了取消按钮则返回0

Else

End If

End With

'释放对象变量

Set oFD = Nothing

End Function