VBA代码大全010：如何用vba遍历文件夹及其子文件夹内的所有文件？

在平时的工作中，我们经常会遇到需要处理同一文件夹下的多个文件的情况。

比如批量修改文件夹内的文件名称、批量导入文件夹内的文件内容、批量移动文件夹内的文件到另一个文件等等。

所有的这些涉及到文件夹内文件的处理，都可以归结为遍历文件夹内的文件，甚至还有需要遍历文件夹及其子文件夹内的文件。

在VBA中，我们可以通过FileSystemObject对象统一处理所有与文件夹、文件相关的操作。

FileSystemObject是封装好的统一处理文件夹、文件的对象。

在之前的文章中，我们介绍了如何遍历单层文件夹中的文件。

今天，我们介绍如何通过FileSystemObject对象遍历文件夹目录及其子文件夹目录。

遍历文件夹目录及其子文件夹目录，实际上是把每一层文件夹都作为一个新的层级，递归调用遍历单层文件夹的代码。

以下是一个通用的遍历文件夹目录及其子文件夹目录的代码：

'遍历文件夹及其子文件夹的通用过程,
'sPath参数表示要获取的文件夹的路径,bEnuSub可选参数表示是否遍历子文件夹，不提供表示不遍历子文件夹
'作者:Excel技术服务
'QQ:1722187970
'邮箱:1722187970@qq.com
Sub EnuAllFiles(ByVal sPath As String, Optional bEnuSub As Boolean = False)
    '定义文件系统对象
    Dim oFso As Object
    Set oFso = CreateObject("Scripting.FileSystemObject")
    '定义文件夹对象
    Dim oFolder As Object
    Set oFolder = oFso.GetFolder(sPath)
    '定义文件对象
    Dim oFile As Object
    '如果指定的文件夹含有文件
    If oFolder.Files.Count Then
        For Each oFile In oFolder.Files
            With oFile
                '输出文件所在的盘符
                Dim sDrive As String
                sDrive = .Drive
                '输出文件的类型
                Dim sType As String
                sType = .Type
                '输出含后缀名的文件名称
                Dim sName As String
                sName = .Name
                '输出含文件名的完整路径
                Dim sFilePath As String
                sFilePath = .Path
                '输出文件的上次修改时间
                Dim dDLM
                dDLM = .DateLastModified
                 '输出文件的上次访问时间
                Dim dDLA
                dDLA = .DateLastAccessed
                 '输出文件的创建时间
                Dim dDC
                dDC = .DateCreated
                 '输出文件的属性
                Dim sATT
                sATT = .Attributes
                '如果文件是Word文件
                If sType Like "*ord*" Then
                    '以下是对每个文件进行处理的代码
                    '*********************************
                    Debug.Print sFilePath
                Else
                End If
            End With
        Next
    '如果指定的文件夹不含有文件
    Else
    End If
    '如果要遍历子文件夹
    If bEnuSub = True Then
        '定义子文件夹集合对象
        Dim oSubFolders As Object
        Set oSubFolders = oFolder.SubFolders
        If oSubFolders.Count > 0 Then
            For Each oTempFolder In oSubFolders
                sTempPath = oTempFolder.Path
                Call EnuAllFiles(sTempPath, True)
            Next
        End If
        Set oSubFolders = Nothing
    End If
    Set oFile = Nothing
    Set oFolder = Nothing
    Set oFso = Nothing
End Sub

以上代码可以作为一个通用代码，随时导入到标准模块中，如果要使用以上通用代码，只需要在子过程中调用即可，如下所示：

Sub QQ1722187970()
    Call EnuAllFiles("F:\百度网盘接收的文件\练习\初级经济法", True)
End Sub

在编写VBA遍历文件夹目录及其子文件夹目录的解决方案时，还经常需要提供可以人机交互选择文件或文件夹的对话框，这时候可以通过添加选择文件夹的对话框代码。

以下是一个通用的从选择文件夹到遍历文件夹内的所有文件的通用代码：

Sub QQ1722187970()
    Excel.Application.ScreenUpdating = False
    Excel.Application.DisplayAlerts = False
    Excel.Application.Calculation = xlCalculationManual
    Dim sPath As String
    '选择要操作的文件夹
    sPath = GetPath()
    If Len(sPath) Then
        '开始遍历选中的文件夹中的所有文件
        EnuAllFiles sPath, False
        MsgBox "操作完成!!!"
    End If
    Excel.Application.Calculation = xlCalculationAutomatic
    Excel.Application.DisplayAlerts = True
    Excel.Application.ScreenUpdating = True
End Sub
'遍历文件夹及其子文件夹的通用过程,
'sPath参数表示要遍历的文件夹的路径,bEnuSub可选参数表示是否遍历子文件夹，不提供表示不遍历子文件夹
'作者:Excel技术服务
'QQ:1722187970
'邮箱:1722187970@qq.com
Sub EnuAllFiles(ByVal sPath As String, Optional bEnuSub As Boolean = False)
    '定义文件系统对象
    Dim oFso As Object
    Set oFso = CreateObject("Scripting.FileSystemObject")
    '定义文件夹对象
    Dim oFolder As Object
    Set oFolder = oFso.GetFolder(sPath)
    '定义文件对象
    Dim oFile As Object
    Dim oWB  As Workbook
    Dim oWK As Worksheet
    Dim oWB1  As Workbook
    Dim oWK1 As Worksheet
    Set oWB = Excel.ThisWorkbook
    Set oWK = oWB.Worksheets(1)
    iRow = oWK.Range("A65536").End(xlUp).Row
    '如果指定的文件夹含有文件
    If oFolder.Files.Count Then
        For Each oFile In oFolder.Files
            With oFile
                '输出文件所在的盘符
                Dim sDrive As String
                sDrive = .Drive
                '输出文件的类型
                Dim sType As String
                sType = .Type
                '输出含后缀名的文件名称
                Dim sName As String
                sName = .Name
                '输出含文件名的完整路径
                Dim sFilePath As String
                sFilePath = .Path
                 '输出文件的上次修改时间
                Dim dDLM
                dDLM = .DateLastModified
                 '输出文件的上次访问时间
                Dim dDLA
                dDLA = .DateLastAccessed
                 '输出文件的创建时间
                Dim dDC
                dDC = .DateCreated
                 '输出文件的属性
                Dim sATT
                sATT = .Attributes
                '如果文件是Excel文件且不是隐藏文件
                If sType Like "*Excel*" And Not (sName Like "*~$*") Then
                    Set oWB1 = Excel.Workbooks.Open(sFilePath)
                    With oWB1
                        Set oWK1 = .Worksheets(1)
                        With oWK1
                            iRow = .Range("a65536").End(xlUp).Row
                            '***********************************
                            '其它操作代码
                            '***********************************
                        End With
                        Excel.Application.Calculation = xlCalculationAutomatic
                        .Close
                    End With
                Else

                End If
            End With
        Next
    '如果指定的文件夹不含有文件
    Else
    End If
    '如果要遍历子文件夹
    If bEnuSub = True Then
        '定义子文件夹集合对象
        Dim oSubFolders As Object
        Set oSubFolders = oFolder.SubFolders
        If oSubFolders.Count > 0 Then
            For Each oTempFolder In oSubFolders
                sTempPath = oTempFolder.Path
                Call EnuAllFiles(sTempPath, True)
            Next
        End If
        Set oSubFolders = Nothing
    End If
    Set oFile = Nothing
    Set oFolder = Nothing
    Set oFso = Nothing
End Sub
Function GetPath() As String
    '声明一个FileDialog对象变量
    Dim oFD As FileDialog
'    '创建一个选择文件对话框
'    Set oFD = Application.FileDialog(msoFileDialogFilePicker)
    '创建一个选择文件夹对话框
    Set oFD = Application.FileDialog(msoFileDialogFolderPicker)
    '声明一个变量用来存储选择的文件名或者文件夹名称
    Dim vrtSelectedItem As Variant
    With oFD
        '允许选择多个文件
        .AllowMultiSelect = True
        '使用Show方法显示对话框，如果单击了确定按钮则返回-1。
        If .Show = -1 Then
            '遍历所有选择的文件
            For Each vrtSelectedItem In .SelectedItems
                '获取所有选择的文件的完整路径,用于各种操作
                GetPath = vrtSelectedItem
            Next
            '如果单击了取消按钮则返回0
        Else
        End If
    End With
    '释放对象变量
    Set oFD = Nothing
End Function
Function GetFileName(ByVal sName As String)
    '获取不含后缀符的纯文件名的自定义函数
    Dim sTemp As String
    sTemp = sName
    '判断后缀名分隔符.的位置
    iPos = Len(sTemp) - VBA.InStr(1, VBA.StrReverse(sTemp), ".")
    If iPos <> 0 Then
        sTemp = Mid(sTemp, 1, iPos)
    End If
    '判断路径分隔符\的位置
    iPos = VBA.InStr(1, sTemp, "\")
    If iPos <> 0 Then
        '反转后好取字符
        iPos = VBA.InStr(1, VBA.StrReverse(sTemp), "\")
        sTemp = Mid(VBA.StrReverse(sTemp), 1, iPos - 1)
        sTemp = VBA.StrReverse(sTemp)
    End If
    GetFileName = sTemp
End Function