之前我们分享了如何提取指定文件夹下工作簿名称的小代码，戳链接： 【Excel VBA】批量提取文件夹下文件名并创建超链接 这期我们分享下，如何提取多层文件夹下文件名的小代码…… 什么意思呢？ 比如说，A文件下有B文件夹，B文件夹下有C文件夹，C文件夹下又有D文件夹…… 也就是传说中的子又生孙，孙又生子；子又有子，子又有孙；子子孙孙无穷匮也……
此时如何提取每个文件夹下的文件名呢？ 代码如下： 代码如看不全，可以左右拖动..▼
Sub AutoAddLink()
Dim strFldPath As String
With Application.FileDialog(msoFileDialogFolderPicker)
'用户选择指定文件夹
.Title = "请选择指定文件夹。"
If .Show Then strFldPath = .SelectedItems(1) Else Exit Sub
'未选择文件夹则退出程序，否则将地址赋予变量strFldPath
End With
Application.ScreenUpdating = False
'关闭屏幕刷新
Range("a:b").ClearContents
Range("a1:b1") = Array("文件夹", "文件名")
Call SearchFileToHyperlinks(strFldPath)
'调取自定义函数SearchFileToHyperlinks
Range("a:b").EntireColumn.AutoFit
'自动列宽
Application.ScreenUpdating = True
'重开屏幕刷新
End Sub
Function SearchFileToHyperlinks(ByVal strFldPath As String) As String
Dim objFld As Object
Dim objFile As Object
Dim objSubFld As Object
Dim strFilePath As String
Dim lngLastRow As Long
Dim intNum As Integer
Set objFld = CreateObject("Scripting.FileSystemObject").GetFolder(strFldPath)
'创建FileSystemObject对象引用
For Each objFile In objFld.Files
'遍历文件夹内的文件
lngLastRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
strFilePath = objFile.Path
intNum = InStrRev(strFilePath, "\")
'使用instrrev函数获取最后文件夹名截至的位置
Cells(lngLastRow, 1) = Left(strFilePath, intNum - 1)
'文件夹地址
Cells(lngLastRow, 2) = Mid(strFilePath, intNum + 1)
'文件名
ActiveSheet.Hyperlinks.Add Anchor:=Cells(lngLastRow, 2), _
Address:=strFilePath, ScreenTip:=strFilePath
'添加超链接
Next objFile
For Each objSubFld In objFld.SubFolders
'遍历文件夹内的子文件夹
Call SearchFileToHyperlinks(objSubFld.Path)
Next objSubFld
Set objFld = Nothing
Set objFile = Nothing
Set objSubFld = Nothing
End Function
代码使用了FileSystemObject对象和递归的方法实现文件夹和文件的遍历功能。分别将文件夹名称和文件名提取在表格的A/B列，并对文件名创建了超链接，示例结果如下图所示。
打个响指……今天给大家分享的VBA小代码就这样…… 最后……提前祝大家春节加班愉快……
专业的职场技能充电站