如何用VBA遍历指定目录下的所有子文件夹和文件

Sub Test()

    Dim MyName, Dic, Did, I, T, F, TT, MyFileName

    T = Time

    Set Dic = CreateObject("ScriptingDictionary")    '创建一个字典对象

    Set Did = CreateObject("ScriptingDictionary")

    DicAdd ("D:\My Documents\"), ""

    I = 0

    Do While I < DicCount

        Ke = Dickeys   '开始遍历字典

        MyName = Dir(Ke(I), vbDirectory)    '查找目录

        Do While MyName <> ""

            If MyName <> "" And MyName <> "" Then

                If (GetAttr(Ke(I) & MyName) And vbDirectory) = vbDirectory Then    '如果是次级目录

                    DicAdd (Ke(I) & MyName & "\"), ""  '就往字典中添加这个次级目录名作为一个条目

                End If

            End If

            MyName = Dir    '继续遍历寻找

        Loop

        I = I + 1

    Loop

    DidAdd ("文件清单"), ""    '以查找D盘My Documents下所有EXCEL文件为例

    For Each Ke In Dickeys

        MyFileName = Dir(Ke & "xls")

        Do While MyFileName <> ""

            DidAdd (Ke & MyFileName), ""

            MyFileName = Dir

        Loop

    Next

    For Each Sh In ThisWorkbookWorksheets

        If ShName = "XLS文件清单" Then

            Sheets("XLS文件清单")CellsDelete

            F = True

            Exit For

        Else

            F = False

        End If

    Next

    If Not F Then

        SheetsAddName = "XLS文件清单"

    End If

    Sheets("XLS文件清单")[A1]Resize(DidCount, 1) = WorksheetFunctionTranspose(Didkeys)

    TT = Time - T

    MsgBox Minute(TT) & "分" & Second(TT) & "秒"

End Sub

下面是控件CommandButton1，单击时执行的代码：

Private Sub CommandButton1_Click()

ApplicationCalculation = xlCalculationManual '手动重算

Dim theSh As Object

Dim theFolder As Object

Set theSh = CreateObject("shellapplication")

Set theFolder = theShBrowseForFolder(0, "", 0, "")

If Not theFolder Is Nothing Then

Range("C3") = theFolderItemsItemPath '在当前表A1单元格录入文件夹路径

End If

ApplicationCalculation = xlCalculationAutomatic '自动重算

End Sub

Sub LoopAllExcelFilesInFolder()

Dim wb As Workbook

Dim myPath As String

Dim myFile As String

Dim myExtension As String

Dim FldrPicker As FileDialog

'这里很关键，决定宏执行快慢的关键

ApplicationScreenUpdating = False

ApplicationEnableEvents = False

ApplicationCalculation = xlCalculationManual

'打开目录选择框

Set FldrPicker = ApplicationFileDialog(msoFileDialogFolderPicker)

With FldrPicker

Title = "请选择目录"

AllowMultiSelect = False

If Show <> -1 Then GoTo NextCode

myPath = SelectedItems(1) & "\"

End With

'取消选择

NextCode:

myPath = myPath

If myPath = "" Then GoTo ResetSettings

'指定过滤的文件后缀

myExtension = "xls"

'遍历全路径

myFile = Dir(myPath & myExtension)

'循环处理每一个文件

Do While myFile <> ""

'打开

Set wb = WorkbooksOpen(Filename:=myPath & myFile)

'确保工作簿被打开，在处理下一个文件时

DoEvents

'设置背景色

wbWorksheets(1)Range("A1:Z1")InteriorColor = RGB(51, 98, 174)

'保存工作簿

wbClose SaveChanges:=True

'确保工作簿被关闭，在处理下一个文件时

DoEvents

'接着处理下一个

myFile = Dir

Loop

'提示处理完成

MsgBox "处理完成!"

ResetSettings:

'恢复设置

ApplicationEnableEvents = True

ApplicationCalculation = xlCalculationAutomatic

ApplicationScreenUpdating = True

End Sub

以上就是关于如何用VBA遍历指定目录下的所有子文件夹和文件全部的内容，包括:如何用VBA遍历指定目录下的所有子文件夹和文件、我想知道 Excel 用vba 如何创建目录选择按钮。 就是单击按钮找到目标文件的路径、vba 遍历指定文件夹（含子目录）获取文件名，哪种方法速度最快等相关内容解答，如果想了解更多相关内容，可以关注我们，你们的支持是我们更新的动力！