批量获取文件夹下的文件文件名称并生成超链接

标题批量获取文件夹下的文件文件名称并设置超链接

本代码的主要目的是通过宏在自行选择好文件夹的情况下，获取文件夹下所有文件的名称（包括子文件内的所有文件），并生成超链接，同时在另外一列也生成了所在文件夹的超链接，方便打开当前文件和文件所在的文件夹，最后将自行将生成的表格保存到电脑上；

一级标题操作流程

1、打开任意一张Excel工作表，选择右键查看代码或者按住ALT+F11打开代码编译器

2、在插入工具栏中插入类模块，并在下列代码复制到模块中

3、运行代码，会先提示选择获取文件名称的文件夹，然后提取文件夹下的所有文件名称，并添加超链接，同时也给每个文件所在的文件夹设置超链接，最后自行将文件保存到自己指定的文件夹中
4、结果如下：

一级标题代码如下：

Sub GetFilesInFolderRecursive()

Dim folderPath As String
Dim fso As Object
Dim folder As Object
Dim file As Object
Dim row As Integer
Dim folderName As String
Dim filePath As String
Dim fileName As String
Dim fileDate As Date

' Prompt user to select folder
With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Select a folder"
    .Show
    folderPath = .SelectedItems(1)
End With

' Create file system object
Set fso = CreateObject("Scripting.FileSystemObject")

' Get folder object
Set folder = fso.GetFolder(folderPath)

' Create new Excel workbook and worksheet
Set wb = Workbooks.Add
Set ws = wb.Sheets(1)

' Add headers to worksheet
ws.Range("A1").Value = "File Name"
ws.Range("B1").Value = "Folder Path"
ws.Range("C1").Value = "File Created"

' Loop through files in folder and its subfolders
row = 2
ProcessFolder folder, ws, row

' Prompt user to save Excel file
With Application.FileDialog(msoFileDialogSaveAs)
    .Title = "Save Excel File"
    .InitialFileName = "File List.xlsx"
    .Show
    wb.SaveAs .SelectedItems(1)
End With

' Close Excel workbook
wb.Close

' Clean up
Set fso = Nothing
Set folder = Nothing
Set file = Nothing
Set wb = Nothing
Set ws = Nothing

End Sub

Sub ProcessFolder(ByVal folder As Object, ByVal ws As Worksheet, ByRef row As Integer)

Dim file As Object
Dim subFolder As Object
Dim folderName As String
Dim filePath As String
Dim fileName As String
Dim fileDate As Date

' Get folder name
folderName = folder.Name

' Process files in current folder
For Each file In folder.Files
    ' Get file name, path and created date
    fileName = file.Name
    fileDate = file.DateCreated
    
    ' Get folder path
    filePath = folder.Path & "\"
    
    ' Add folder path and file name to worksheet
    ws.Range("A" & row).Value = fileName
    ws.Range("B" & row).Formula = "=HYPERLINK(""" & folder.Path & """, """ & folderName & """)"
    ws.Range("C" & row).Value = fileDate
    
    ' Create hyperlink to file
    ws.Hyperlinks.Add Anchor:=ws.Range("A" & row), _
        Address:=file.Path, _
        TextToDisplay:=fileName
    
    row = row + 1
Next

' Recursively process subfolders
For Each subFolder In folder.SubFolders
    ProcessFolder subFolder, ws, row
Next

End Sub