遍历指定目录下的所有文件

最新推荐文章于 2022-11-24 10:57:49 发布

garnett2003

最新推荐文章于 2022-11-24 10:57:49 发布

阅读量1.3k

点赞数

分类专栏： vba 文章标签： excel path 审查 each 工作

本文链接：https://blog.csdn.net/garnett2003/article/details/6928521

版权

vba 专栏收录该内容

6 篇文章 0 订阅

订阅专栏

'以查找D:\盘下所有EXCEL文件为例
Sub M_dir() '这是一个主模块，中间调用两人子模块，一个遍历指定目录下的所有文件夹，一个遍历文件夹下的所有EXCEL文件
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    On Error Resume Next
    Sheets.Add.Name = "路径"
    If Err.Number <> 0 Then
        ActiveSheet.Delete
        Sheets("路径").Cells.Delete
        Err.Clear: On Error GoTo 0
    End If
    Set Sh = Sheets("路径")
    Sh.[a1] = "E:\2011年工作\审查会议\二、三、四批明细\" '以查找D盘下所有EXCEL文件为例
    i = 1
    Do While Sh.Cells(i, 1) <> ""
        dirdir (Sh.Cells(i, 1))
        i = i + 1
    Loop
        On Error Resume Next
    Sheets.Add.Name = "XLS文件"
    If Err.Number <> 0 Then
        ActiveSheet.Delete
        Sheets("XLS文件").Cells.Delete
        Err.Clear: On Error GoTo 0
    End If
    Set sh2 = Sheets("XLS文件")
    sh2.Cells(1, 1) = "文件清单"
    For Each cel In Sh.[a1].CurrentRegion
        Call dirf(cel.Value)
    Next
End Sub
Sub dirf(My_Path) '遍历文件夹下的所有EXCEL文件
    Set sh2 = Sheets("XLS文件")
    mm = sh2.[a65536].End(xlUp).Row + 1
    MyFilename = Dir(My_Path & "*.xl*")
    Do While MyFilename <> ""
        sh2.Cells(mm, 1) = My_Path & MyFilename
        mm = mm + 1
        MyFilename = Dir
    Loop
End Sub
Sub dirdir(MyPath) '遍历指定目录下的所有文件夹
    Dim MyName
   Set Sh = Sheets("路径")
    MyName = Dir(MyPath, vbDirectory)
    m = Sh.[a65536].End(xlUp).Row + 1
    Do While MyName <> ""
        If MyName <> "." And MyName <> ".." Then
            If (GetAttr(MyPath & MyName) And vbDirectory) = vbDirectory Then
                Sh.Cells(m, 1) = MyPath & MyName & "\"
                m = m + 1
            End If
        End If
        MyName = Dir
    Loop
End Sub