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

（一）VB语句方式

''''程序入口↓

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

Sub GetFileList()

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

    Columns(2).Clear

    DimfileName, folderPath As String

    DimrowIndexA, rowIndexB, maxRow, lastRowA As Integer

    maxRow =Rows.Count

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

    ForrowIndexA = 1 TolastRowA

        folderPath =Cells(rowIndexA, 1).Value

        fileName =Dir(folderPath)

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

        Do WhilefileName <> ""

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

           rowIndexB = rowIndexB + 1

           fileName = Dir

        Loop

    NextrowIndexA

End Sub

 

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

Sub GetFolderList()

    DimfolderName 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 UntilfolderName = ""

        i =i + 1

    Loop

End Sub

 

 

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

Function GetMainDirectory(ByValDialogType As MsoFileDialogType) As String

  WithApplication.FileDialog(DialogType)

    If .Show= True Then

       GetMainDirectory = .SelectedItems(1)

    End If

  End With

End Function

 

（二）FSO方式

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

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

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

''''程序入口↓

''''获取文件列表

Sub FsoGetFileList()

    DimfolderPath As String

    Dim maxRow,lastRow, maxRowB, LastRowB As Integer

    Dim i As Integer

    Dim folder,allFiles As Object

    Dim fso As NewFileSystemObject

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

    Columns(2).Clear

    maxRow =Rows.Count

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

    For i =1 TolastRow

        folderPath =Cells(i, 1).Value

        Set folder= fso.GetFolder(folderPath)

        SetallFiles = folder.Files

        maxRowB =Rows.Count

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

        For Each File InallFiles

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

           LastRowB = LastRowB + 1

        Next

    Next i

End Sub

''''获取文件夹列表

Sub FsoGetFolderList()

    DimrowIndex As Integer

    DimfolderPath As String

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

    folderPath =GetMainDirectory(msoFileDialogFolderPicker)

    rowIndex =1

    Columns(1).Clear

    Do

        IfrowIndex = 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）的子文件夹

 FunctionGetFolderPath(mainFolderPath)

    DimmainFolder, childFolders As Object

    Dim index As Integer

    ''''创建FileSystemObject对象fso

    Dim fso As NewFileSystemObject

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

    SetmainFolder = fso.GetFolder(mainFolderPath)

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

    SetchildFolders = mainFolder.SubFolders

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

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

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

    For Eachchildfolder In childFolders

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

        index =index + 1

    Next

 End Function

 

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

Function GetMainDirectory(ByValDialogType As MsoFileDialogType) As String

  WithApplication.FileDialog(DialogType)

    If .Show= True Then

       GetMainDirectory = .SelectedItems(1)

    End If

  End With

End Function