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

四、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 =1To 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,".")=0And _
(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 =1To 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 =1Then
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。