在上一篇文章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
另外这几天是新型冠状病毒肺炎的高发期,小伙伴们一定要减少出门,防止感染新型冠状病毒肺炎。