返回目录：excel表格制作
很多人平时存放文件时喜欢胡乱放，总想着回头整理放好，但经常就忘了，到要用的时候，总是找不到，懊恼不已。今天和大家分享一个用excel快速生成目录帮助查找的方法。
先来看看效果视频
图中分别对文件夹和文件设置了一键生成目录的效果，同时自动设置了超链接，用于点击后直接打开。
有人通过超级表格的查询功能也能得到类似效果，但是只有13版及以上版本才能使用超级表，而且设置步骤比较麻烦，没有一定功底难以掌握。
本文为VBA代码生成，只需在表中插入一个图标，指定对应的宏，导入本文文末提供的模块即可。不会代码也不要紧，只要会启用宏导入模块或粘贴代码。但是心急的朋友最好不要直接跳到文末去找模块，因为有两个设置比较重要，漏掉有模块也用不成。
重要设置1
虽然模块内代码已经编写完善，但由于代码使用了FileSystemObject对象，默认的VBE是没有启用该对象的，需要提前引用。
具体方法：VBE--工具--引用--找到miscrosoft scription runtime项目并选中
没有这步设置，代码是无法运行的。
重要设置2
表格是自动建立了超链接的，有时候当点击打开超链接时会弹出提示注意来源安全问题，点击是即可，但是当每次都要点一下才能打开超链接显示不是我们想要的。遇到这种情况，需要将我们选定的路径即B1单元格内容，添加到受信任位置。
具体方法：开发工具—宏安全性—受信任位置—添加新位置
在表格中插入形状或图片，右键形状或图片指定宏，选择对应的宏名确定即可。
具体方法：
Public fso As New FileSystemObject, fd As Folder, sfd As Folder, arrfiles(1000), cntFiles%Public Sub 文件夹目录() Dim n1 As Integer p = GetFolderName(msoFileDialogFolderPicker) Set fd = fso.GetFolder(p & "") cntFiles = 0 If Len(fd) <= 4 Then Exit Sub SearchFolders fd ActiveSheet.Cells.ClearContents ActiveSheet.Cells(1, 2) = p & "" For i = 2 To cntFiles + 1 ActiveSheet.Cells(i, 1) = arrfiles(i - 1) ActiveSheet.Cells(i, 2).FormulaR1C1 = "=HYPERLINK(RC[-1],SUBSTITUTE(RC[-1],R1C2,""""))" NextEnd SubPublic Sub 文件目录() p = GetFolderName(msoFileDialogFolderPicker) Set fd = fso.GetFolder(p & "") cntFiles = 0 If Len(fd) <= 4 Then Exit Sub SearchFiles fd ActiveSheet.Cells.ClearContents ActiveSheet.Cells(1, 2) = p & "" For i = 2 To cntFiles + 1 ActiveSheet.Cells(i, 1) = arrfiles(i - 1) ActiveSheet.Cells(i, 2).FormulaR1C1 = "=HYPERLINK(RC[-1],SUBSTITUTE(RC[-1],R1C2,""""))" NextEnd SubPublic Function GetFolderName(ByVal DialogType As MsoFileDialogType) As String With Application.FileDialog(DialogType) If .Show = True Then GetFolderName = .SelectedItems(1) End If End WithEnd FunctionSub SearchFolders(ByVal fd As Folder) n = n + 1 If fd.SubFolders.Count = 0 Then Exit Sub For Each sfd In fd.SubFolders cntFiles = cntFiles + 1 arrfiles(cntFiles) = sfd SearchFolders sfd NextEnd SubSub SearchFiles(ByVal fd As Folder) For Each fl In fd.Files cntFiles = cntFiles + 1 arrfiles(cntFiles) = fl.Path Next fl If fd.SubFolders.Count = 0 Then Exit Sub For Each sfd In fd.SubFolders SearchFiles sfd NextEnd Sub