VBA编程提取文件夹内所有文件名到Excel并生成超链接

在上一篇文章Excel VBA 操作文件（夹）神器--FSO对象，我们讲解了FSO（FileSystemObject）对象，今天我们将通过一个具体的实例来加深我们对FSO对象的理解。

既然FSO对象是操作文件（夹）神器，那么今天我们就用VBA编程来实现将指定文件夹内的所有文件名提取到Excel并生成超链接。

具体实现效果如下：

这个例程中，我们用到了FSO对象的GetFolder方法。具体实现代码如下图所示：

Sub FSO_FileExtraction()

'定义文件夹路径变量

Dim strFldPath As String

'用户选择指定文件夹

With Application.FileDialog(msoFileDialogFolderPicker)

.Title = "请选择指定文件夹。"

'如果用户没有制定文件夹，则退出程序

If .Show Then strFldPath = .SelectedItems(1) Else Exit Sub

End With

'关闭屏幕刷新

Application.ScreenUpdating = False

Range("a:b").ClearContents

Range("a1:b1") = Array("文件夹", "文件名及超链接")

'调取文件提取及增加超链接的函数

Call ExtractionFileAddHyperlinks(strFldPath)

'自动列宽

Range("a:b").EntireColumn.AutoFit

'打开屏幕刷新

Application.ScreenUpdating = True

End Sub

子函数ExtractionFileAddHyperlinks 如下图所示：

Function ExtractionFileAddHyperlinks(ByVal strFldPath As String) As String

'定义变量

Dim objMyFSO As Object

Dim objFld As Object

Dim objFile As Object

Dim objSubFld As Object

Dim strFilePath As String

Dim lngLastRow As Long

Dim intNum As Integer

'用直接创建法 创建FSO对象

Set objMyFSO = CreateObject("Scripting.FileSystemObject")

'调用FSO的GetFolder方法

Set objFld = objMyFSO.GetFolder(strFldPath)

'遍历文件夹内的文件

For Each objFile In objFld.Files

lngLastRow = Cells(Rows.Count, 1).End(xlUp).Row + 1

strFilePath = objFile.Path

'使用instrrev函数获取最后文件夹名截至的位置

intNum = InStrRev(strFilePath, "\")

'获取文件夹绝对地址

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 ExtractionFileAddHyperlinks(objSubFld.Path)

Next objSubFld

'清空对象变量

Set objMyFSO = Nothing

Set objFld = Nothing

Set objFile = Nothing

Set objSubFld = Nothing

End Function

另外这几天是新型冠状病毒肺炎的高发期，小伙伴们一定要减少出门，防止感染新型冠状病毒肺炎。