VBA学习(13):获取多层文件夹内文件名并建立超链接
代码使用了FileSystemObject对象和递归的方法实现文件夹和文件的遍历功能。分别将文件夹名称和文件名提取在表格的A/B列，并对文件名创建了超链接。
示例代码如下：
Sub AutoAddLink()Dim strFldPath As StringWith Application.FileDialog(msoFileDialogFolderPicker)'用户选择指定文件夹.Title = "请选择指定文件夹。"If .Show Then strFldPath = .SelectedItems(1) Else Exit Sub'未选择文件夹则退出程序，否则将地址赋予变量strFldPathEnd WithApplication.ScreenUpdating = False'关闭屏幕刷新Range("a:b").ClearContentsRange("a1:b1") = Array("文件夹", "文件名")Call SearchFileToHyperlinks(strFldPath)'调取自定义函数SearchFileToHyperlinksRange("a:b").EntireColumn.AutoFit'自动列宽Application.ScreenUpdating = True'重开屏幕刷新
End Sub
Function SearchFileToHyperlinks(ByVal strFldPath As String) As StringDim objFld As ObjectDim objFile As ObjectDim objSubFld As ObjectDim strFilePath As StringDim lngLastRow As LongDim intNum As IntegerSet objFld = CreateObject("Scripting.FileSystemObject").GetFolder(strFldPath)'创建FileSystemObject对象引用For Each objFile In objFld.Files'遍历文件夹内的文件lngLastRow = Cells(Rows.Count, 1).End(xlUp).Row + 1strFilePath = objFile.PathintNum = 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 objFileFor Each objSubFld In objFld.SubFolders'遍历文件夹内的子文件夹Call SearchFileToHyperlinks(objSubFld.Path)Next objSubFldSet objFld = NothingSet objFile = NothingSet objSubFld = Nothing
End Function