Excel vba——递归算法导出所有文件夹和文件

山水CAD插件定制

已于 2025-06-02 23:49:13 修改

阅读量109

点赞数 2

CC 4.0 BY-SA版权

分类专栏：函数（VBA）文章标签： java 服务器前端

于 2024-07-30 20:15:20 首次发布

本文链接：https://blog.youkuaiyun.com/yongshiqq/article/details/140805687

函数（VBA）专栏收录该内容

47 篇文章

订阅专栏

 Public textfile As String
 Sub 递归函数输出所有文件和文件夹()
'yngqq443440204@2024年7月31日11:14:28
    'On Error Resume Next
    textfile = "C:\Users\Administrator\Desktop\1.txt"
    Open textfile For Output As #1
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1") ' 假设输出到Sheet1
    ws.Cells.Clear ' 清除Sheet1的所有内容
    ws.Cells(1, 1).Value = "路径/文件名" ' 标题
      
    ' 从E盘根目录开始遍历
    Call TraverseFolder("G:\", 2)
    MsgBox "ok"
    Close #1
End Sub
Sub TraverseFolder(folderPath As String, row As Long)
Dim ws As Worksheet
Set ws = ActiveSheet
    Dim fs As Object
    Set fs = CreateObject("Scripting.FileSystemObject")
    Dim folder As Object
    Set folder = fs.GetFolder(folderPath)
    Dim subFolder As Object
    Dim file As Object
      
    ' 遍历子文件夹
    For Each subFolder In folder.SubFolders
        If InStr(1, subFolder.path, "System Volume Information", 1) > 0 Then '出现这个会拒绝访问，停止扫描接下来文件夹
             'Stop
        Else
             
                Print #1, subFolder.path ' & vbCrLf
              
                ws.Cells(row, 1).Value = subFolder.path
                row = row + 1
                ' 递归调用
                Call TraverseFolder(subFolder.path, row)
        End If
     Next subFolder
    
    ' 遍历文件
    For Each file In folder.Files
    
        Print #1, file.path ' & vbCrLf
     
        ws.Cells(row, 1).Value = file.path
        row = row + 1
    Next file
End Sub