很多人平时存放文件时喜欢胡乱放，总想着回头整理放好，但经常就忘了，到要用的时候，总是找不到，懊恼不已。今天和大家分享一个用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,""""))"
 Next
End Sub
Public 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,""""))"
 Next
End Sub
Public Function GetFolderName(ByVal DialogType As MsoFileDialogType) As String
 With Application.FileDialog(DialogType)
 If .Show = True Then
 GetFolderName = .SelectedItems(1)
 End If
 End With
End Function
Sub 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
 Next
End Sub
Sub 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
 Next
End Sub