【原】四、VBA获取目录、文件路径简明代码（VB语句、FSO两种方式）

（一）VB语句方式

''''程序入口↓

''''获取所有文件路径

Sub GetFileList()

    Call GetFolderList ''''调用GetFolderList()过程获取所有文件夹路径

    Columns(2).Clear

    Dim fileName, folderPath As String

    Dim rowIndexA, rowIndexB, maxRow, lastRowA As Integer

    maxRow = Rows.Count

    lastRowA = Cells(maxRow, 1).End(xlUp).Row

    For rowIndexA = 1 To lastRowA

        folderPath = Cells(rowIndexA, 1).Value

        fileName = Dir(folderPath)

        rowIndexB = Cells(maxRow, 2).End(xlUp).Row + 1

        Do While fileName <> ""

            Cells(rowIndexB, 2).Value = folderPath & fileName

            rowIndexB = rowIndexB + 1

            fileName = Dir

        Loop

    Next rowIndexA

End Sub

 

''''获取GetMainDirectory拾取文件夹路径下的所有文件夹，放到A列

Sub GetFolderList()

    Dim folderName As String

    Dim i, k As Integer

    Columns(1).Clear

    Cells(1, 1).Value = GetMainDirectory(msoFileDialogFolderPicker) & "\"

    i = 1

    k = 1

    Do While i <= k

        folderName = Dir(Cells(i, 1).Value, vbDirectory)

        Do

            If InStr(folderName, ".") = 0 And _

            (GetAttr(Cells(i, 1).Value & folderName) And vbDirectory) = vbDirectory Then

                   k = k + 1

                   Cells(k, 1).Value = Cells(i, 1).Value & folderName & "\"

            End If

            folderName = Dir

        Loop Until folderName = ""

        i = i + 1

    Loop

End Sub

 

 

''''函数，拾取一个文件夹路径，返回路径字符串

Function GetMainDirectory(ByVal DialogType As MsoFileDialogType) As String

  With Application.FileDialog(DialogType)

    If .Show = True Then

        GetMainDirectory = .SelectedItems(1)

    End If

  End With

End Function

 

（二）FSO方式

''''##############################

''''工具——引用 类库文件"Microsoft Scripting Runtime"

''''##############################

''''程序入口↓

''''获取文件列表

Sub FsoGetFileList()

    Dim folderPath As String

    Dim maxRow, lastRow, maxRowB, LastRowB As Integer

    Dim i As Integer

    Dim folder, allFiles As Object

    Dim fso As New FileSystemObject

    Call FsoGetFolderList ''''调用FsoGetFolderList方法获取目录列表

    Columns(2).Clear

    maxRow = Rows.Count

    lastRow = Cells(maxRow, 1).End(xlUp).Row

    For i = 1 To lastRow

        folderPath = Cells(i, 1).Value

        Set folder = fso.GetFolder(folderPath)

        Set allFiles = folder.Files

        maxRowB = Rows.Count

        LastRowB = Cells(maxRowB, 2).End(xlUp).Row + 1

        For Each File In allFiles

            Cells(LastRowB, 2).Value = File.Path

            LastRowB = LastRowB + 1

        Next

    Next i

End Sub

''''获取文件夹列表

Sub FsoGetFolderList()

    Dim rowIndex As Integer

    Dim folderPath As String

    ''''调用函数获取主文件夹目录

    folderPath = GetMainDirectory(msoFileDialogFolderPicker)

    rowIndex = 1

    Columns(1).Clear

    Do

        If rowIndex = 1 Then

            GetFolderPath (folderPath)

            Cells(rowIndex, 1).Value = folderPath

        Else

            GetFolderPath (Cells(rowIndex, 1).Value)

        End If

        rowIndex = rowIndex + 1

    Loop Until Cells(rowIndex, 1).Value = ""

End Sub

 

''''定义函数，作用是获取给定文件夹路径（mainFolderPath）的子文件夹

 Function GetFolderPath(mainFolderPath)

    Dim mainFolder, childFolders As Object

    Dim index As Integer

    ''''创建FileSystemObject对象fso

    Dim fso As New FileSystemObject

    ''''从路径获得folder对象mainFolder

    Set mainFolder = fso.GetFolder(mainFolderPath)

    ''''获得mainFolder的子目录集合childFolders

    Set childFolders = mainFolder.SubFolders

    ''''行号初始值设定为A列最后一个非空行的+1行，第一次执行的时候index=2

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

    ''''for each ……in 遍历集合取每一个子目录childFolder的路径path

    For Each childfolder In childFolders

        Cells(index, 1).Value = childfolder.Path ''''路径

        index = index + 1

    Next

 End Function

 

''''函数，拾取一个文件夹路径，返回路径字符串

Function GetMainDirectory(ByVal DialogType As MsoFileDialogType) As String

  With Application.FileDialog(DialogType)

    If .Show = True Then

        GetMainDirectory = .SelectedItems(1)

    End If

  End With

End Function