批量汇总指定文件夹及其子文件夹下所有文件是我们日常工作中一个很高频的需求，今天分享的小程序可以一键提取指定文件夹及其子文件夹下所有文件的文件名、文件路径和文件大小，同时在文件路径列生成超链接，点击即可直接打开目标文件：
https://pan.baidu.com/s/1a7s9JITuDjSwCi-Ym-6V5Q?pwd=iReg
同时把VBA源代码分享如下，欢迎大家提出宝贵意见，以便不断改进：
Private Sub CommandButton1_Click()Dim folderPath As StringDim objFSO As ObjectDim objFolder As ObjectDim objFile As ObjectDim objSubFolder As ObjectDim ws As WorksheetDim row As Long' 创建一个FileDialog对象用于选择文件夹With Application.FileDialog(msoFileDialogFolderPicker).Title = "请选择需要处理的文件夹".AllowMultiSelect = False' 显示对话框并获取用户选择的文件夹路径If .Show = -1 ThenfolderPath = .SelectedItems(1)ElseMsgBox "未选择文件夹，操作已取消。"Exit SubEnd IfEnd With' 创建文件系统对象Set objFSO = CreateObject("Scripting.FileSystemObject")' 设置工作表为当前工作簿的第1个工作表Set ws = ThisWorkbook.Worksheets(1)' 设置标题行ws.Cells(2, 1).Value = "文件大小（KB）"ws.Cells(2, 2).Value = "文件名"ws.Cells(2, 3).Value = "文件路径"' 初始化行号row = 3' 调用递归过程列出文件及其大小Call ListFiles(objFSO.GetFolder(folderPath), ws, row)'设置工作表格式ws.Range("A2:C2").Font.Bold = Truews.Range("B3").SelectActiveWindow.FreezePanes = TrueWith ws.Range("A2").CurrentRegion.HorizontalAlignment = xlLeft.VerticalAlignment = xlCenterEnd With' 释放对象Set objFSO = NothingMsgBox "文件信息已写入工作表！"End SubSub ListFiles(ByVal objFolder As Object, ByVal ws As Worksheet, ByRef row As Long)Dim objFile As ObjectDim objSubFolder As ObjectDim fileSizeKB As Double' 遍历文件夹中的每个文件For Each objFile In objFolder.Files' 计算文件大小（以KB为单位）fileSizeKB = objFile.Size / 1024' 将文件大小、文件名和文件路径写入工作表并对第3列创建超链接ws.Cells(row, 1).Value = Round(fileSizeKB, 1)ws.Cells(row, 2).Value = objFile.Namews.Cells(row, 3).Value = objFile.Pathws.Hyperlinks.Add Anchor:=ws.Cells(row, 3), Address:=ws.Cells(row, 3).Value, TextToDisplay:=ws.Cells(row, 3).Value' 增加行号以便下一个文件row = row + 1Next objFile' 遍历文件夹中的每个子文件夹For Each objSubFolder In objFolder.SubFolders' 递归调用列出子文件夹中的文件Call ListFiles(objSubFolder, ws, row)Next objSubFolderEnd Sub
