看到有吧友问如何 VBA中遍历 文件夹下(含有子文件夹) 的所有文件,就做了一个示例教程。
' VBA中遍历文件夹下所有文件(含子文件夹)的方法很多
' 但有些方法有一定的局限,如Dir()的方法遍历子文件夹文件不太方便
' 而 FileSearch方法在office 2007中微软把Application对象FileSearch方法删除了
' 所有比较安全的方法是使用 FileSystemObject对象实现遍历文件夹及子文件夹中所有文件
' 为避免显式引用FileSystemObject,我们使用Set fso = CreateObject("Scripting.FileSystemObject")创建对象
Dim lngSeqNo As Long
Sub 矩形圆角1_Click()
测试程序
End Sub
Public Sub 测试程序()
Dim strPath As String
Dim fso As Object, objFolder As Object
Set fso = CreateObject("Scripting.FileSystemObject")
lngSeqNo = 0
strPath = "E:\NewTools\TreesizePro\TreeSize_7.1.3_Portable" '可改成你自己的指定目录
Set objFolder = fso.GetFolder(strPath)
GetAllFiles objFolder
' ReDim Preserve arrFiles(1 To lngFileCnt)
' For i = 1 To lngFileCnt
' Debug.Print arrFiles(i)
' Next i
End Sub
Sub GetAllFiles(ByVal objFolder As Object)
Dim objFile As Object ' File
Dim objSubFolder As Object ' Folder
Dim arrFiles()
Dim lngFileCnt As Long
Dim i As Long
ReDim arrFiles(1 To 1000)
lngFileCnt = 0
For Each objFile In objFolder.Files
lngFileCnt = lngFileCnt + 1
If lngFileCnt > UBound(arrFiles) Then ReDim Preserve arrFiles(1 To lngFileCnt + 1000)
lngSeqNo = lngSeqNo + 1
' arrFiles(lngFileCnt) = objFile.Path
ActiveSheet.Cells(lngSeqNo, 1).Value = objFile.Path
Next objFile
If objFolder.SubFolders.Count = 0 Then Exit Sub
For Each objSubFolder In objFolder.SubFolders
GetAllFiles objSubFolder
Next
End Sub
执行后的结果写到Excel单元格中,效果如下

' VBA中遍历文件夹下所有文件(含子文件夹)的方法很多
' 但有些方法有一定的局限,如Dir()的方法遍历子文件夹文件不太方便
' 而 FileSearch方法在office 2007中微软把Application对象FileSearch方法删除了
' 所有比较安全的方法是使用 FileSystemObject对象实现遍历文件夹及子文件夹中所有文件
' 为避免显式引用FileSystemObject,我们使用Set fso = CreateObject("Scripting.FileSystemObject")创建对象
Dim lngSeqNo As Long
Sub 矩形圆角1_Click()
测试程序
End Sub
Public Sub 测试程序()
Dim strPath As String
Dim fso As Object, objFolder As Object
Set fso = CreateObject("Scripting.FileSystemObject")
lngSeqNo = 0
strPath = "E:\NewTools\TreesizePro\TreeSize_7.1.3_Portable" '可改成你自己的指定目录
Set objFolder = fso.GetFolder(strPath)
GetAllFiles objFolder
' ReDim Preserve arrFiles(1 To lngFileCnt)
' For i = 1 To lngFileCnt
' Debug.Print arrFiles(i)
' Next i
End Sub
Sub GetAllFiles(ByVal objFolder As Object)
Dim objFile As Object ' File
Dim objSubFolder As Object ' Folder
Dim arrFiles()
Dim lngFileCnt As Long
Dim i As Long
ReDim arrFiles(1 To 1000)
lngFileCnt = 0
For Each objFile In objFolder.Files
lngFileCnt = lngFileCnt + 1
If lngFileCnt > UBound(arrFiles) Then ReDim Preserve arrFiles(1 To lngFileCnt + 1000)
lngSeqNo = lngSeqNo + 1
' arrFiles(lngFileCnt) = objFile.Path
ActiveSheet.Cells(lngSeqNo, 1).Value = objFile.Path
Next objFile
If objFolder.SubFolders.Count = 0 Then Exit Sub
For Each objSubFolder In objFolder.SubFolders
GetAllFiles objSubFolder
Next
End Sub
执行后的结果写到Excel单元格中,效果如下
