之前我們分享了如何提取指定檔案夾下工作簿名稱的小代碼，戳連結： 【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小代碼就這樣…… 最後……提前祝大家春節加班愉快……
專業的職場技能充電站