大公司的文件夹路径比较深，很多人会用Excel 手动去汇总这些快捷方式。

如何快速生成某个大路径下的自定义层数的地址呢？（如下图）

之前的案例是因为需要用到机器学习或者自定义图形生成，所以用python比较方便。但这回的需求仅仅需要和Office进行快捷交互，没有什么比VBA更合适的了。

步骤如下：

在B1单元格填上你需要的统计的地址，如：S:\AB1000\CD2000\EF1001

在L1单元格填上你要统计的文件夹深度，如4层就填“4”

按Alt+F11打开VBA编辑器，输入以下代码：

Sub统计路径()DimfolderPath As StringDimexcelSheet As ObjectDimexcelRow As LongDimexcelCol As LongDimmaxDepth As Integer ’ 最大遍历深度’设置Excel表格的Sheet1为当前活动工作表SetexcelSheet = ThisWorkbook.Sheets(“Sheet2”) ’ 修改为您的表格名称’获取文件夹路径folderPath = excelSheet.Range(“B1”).Value’获取最大深度maxDepth = excelSheet.Range(“L1”).Value’初始化行数和列数excelRow = 2excelCol = 1’调用递归函数进行文件夹整理RecursiveFolderfolderPath, excelSheet, excelRow, excelCol, 0, maxDepth’释放对象SetexcelSheet = NothingEndSub

SubRecursiveFolder(folderPath As String, excelSheet As Object, ByRef excelRow As Long, ByRef excelCol As Long, ByVal currentDepth As Integer, ByVal maxDepth As Integer)‘获取文件夹对象Dimfolder As ObjectSetfolder = CreateObject(“Scripting.FileSystemObject”).GetFolder(folderPath)‘将文件夹名称放入Excel表格，并添加链接excelSheet.Hyperlinks.AddAnchor:=excelSheet.Cells(excelRow, excelCol), Address:=folder.Path, TextToDisplay:=folder.Name’遍历子文件夹，仅当当前深度小于等于最大深度时递归调用IfcurrentDepth < maxDepth ThenDimsubFolder As ObjectForEach subFolder In folder.SubFolders’增加行数excelRow = excelRow + 1’将子文件夹名称放入Excel表格，并添加链接excelSheet.Hyperlinks.AddAnchor:=excelSheet.Cells(excelRow, excelCol + 1), Address:=subFolder.Path, TextToDisplay:=subFolder.Name’递归调用RecursiveFoldersubFolder.Path, excelSheet, excelRow, excelCol + 1, currentDepth + 1, maxDepthNextsubFolderEndIf’释放对象SetsubFolder = NothingSetfolder = NothingEnd Sub

运行该程序，就可以自动汇总这些地址了。

程序会自动在表格中按照文件夹的级别建立文件名，并将路径赋予这个文件名。

今后我们只要点击这个文件名就可以进入这个文件夹了。更新也非常简单，再运行一下程序就可以了。