VBA提取文件目录并超链接

怎么才能快速提取指定文件夹内字文件夹的文件名，要做到这一步其实非常简单，用一段VBA代码就可以搞定了。

VBA代码－提取文件夹名

Sub getFldList1()

    Dim Fso, Fld

    Dim Arr(1 To 999), k%

    Set Fso = CreateObject('Scripting.FileSystemObject')

    Set Fld = Fso.getfolder(CreateObject('Shell.Application').BrowseForFolder(0, '请选择文件夹', 0, '').Self.Path & '\')

    For Each fd In Fld.subfolders

        k = k 1

        Arr(k) = fd.Name

    Next

    [A1].Resize(k) = Application.Transpose(Arr)

End Sub

有时候我更需要提取文件夹内所含文件的文件名，这时候需要用下面的代码：

VBA代码－提取文件名

Sub 提取指定文件夹内的所有文件名() '含所有子文件夹内的文件

    Dim Fso As Object, arrf$(), mf&

    Set Fso = CreateObject('Scripting.FileSystemObject')

    Call GetFiles(CreateObject('Shell.Application').BrowseForFolder(0, '请选择文件夹', 0, '').Self.Path, Fso, arrf, mf)

    [b1].Resize(mf) = Application.Transpose(arrf)

    Set Fso = Nothing

End Sub

Private Sub GetFiles(ByVal sPath$, ByRef Fso As Object, ByRef arrf$(), ByRef mf&)

    Dim Folder As Object

    Dim SubFolder As Object

    Dim File As Object

    Set Folder = Fso.GetFolder(sPath)

    

    For Each File In Folder.Files

        mf = mf 1

        ReDim Preserve arrf(1 To mf)

        arrf(mf) = File.Name

    Next

    For Each SubFolder In Folder.SubFolders

        Call GetFiles(SubFolder.Path, Fso, arrf, mf)

    Next

    Set Folder = Nothing

    Set File = Nothing

End Sub

上面只是小试一下，下面给大家分享一个完整的例子并且超级强大，请大家看我的演示：

下载地址：链接: http://pan.baidu.com/s/1c1W3rlI 密码: 572q