循环浏览用户指定的根目录中的子文件夹和文件 [英] Cycle through sub-folders and files in a user-specified root directory

问题描述

我通过单个文件的循环脚本工作正常，但我现在还需要它来查看/查找多个目录.我被卡住了....

My cycling script through individual files works fine, but I now need it to also look through/for multiple directories. I am stuck....

事情发生的顺序:

• 提示用户选择他们需要的根目录
• 我需要脚本来查找该根目录中的任何文件夹
• 如果脚本找到一个，它会打开第一个(所有文件夹，因此没有文件夹的特定搜索过滤器)
• 一旦打开，我的脚本将遍历文件夹中的所有文件并执行它需要执行的操作
• 完成后，它会关闭文件、关闭目录并移动到下一个目录，等等.
• 循环直到所有文件夹都被打开/扫描

这就是我所拥有的，但它不起作用，我知道这是错误的:

This is what I have, which doesn't work and I know is wrong:

MsgBox "Please choose the folder."
Application.DisplayAlerts = False
With Application.FileDialog(msoFileDialogFolderPicker)
    .InitialFileName = "\blah	est"
    .AllowMultiSelect = False
    If .Show <> -1 Then MsgBox "No folder selected! Exiting script.": Exit Sub
    CSRootDir = .SelectedItems(1)
End With
folderPath = Dir(CSRootDir, "*")

Do While Len(folderPath) > 0
    Debug.Print folderPath
    fileName = Dir(folderPath & "*.xls")
    If folderPath <> "False" Then
        Do While fileName <> ""
            Application.ScreenUpdating = False
            Set wbkCS = Workbooks.Open(folderPath & fileName)

            --file loop scripts here

        Loop  'back to the Do
Loop    'back to the Do

最终代码.它循环遍历所有子目录和每个子目录中的文件.

Final Code. It cycles through all sub-directories and files in each sub-directory.

Dim FSO As Object, fld As Object, Fil As Object
Dim fsoFile As Object 
Dim fsoFol As Object 
Dim fileName As String

    MsgBox "Please choose the folder."
    Application.DisplayAlerts = False
    With Application.FileDialog(msoFileDialogFolderPicker)
         .InitialFileName = "\blah	est"
         .AllowMultiSelect = False
         If .Show <> -1 Then MsgBox "No folder selected! Exiting script.": Exit Sub
         folderPath = .SelectedItems(1)
    End With

    If Right(folderPath, 1) <> "" Then folderPath = folderPath + ""
         Set FSO = CreateObject("Scripting.FileSystemObject")
         Set fld = FSO.getfolder(folderPath)
    If FSO.folderExists(fld) Then
         For Each fsoFol In FSO.getfolder(folderPath).subfolders
              For Each fsoFile In fsoFol.Files
                   If Mid(fsoFile.Name, InStrRev(fsoFile.Name, ".") + 1) = "xls" Then
    fileName = fsoFile.Name
    Application.ScreenUpdating = False
    Set wbkCS = Workbooks.Open(fsoFile.Path)

    'My file handling code


                End If
              Next
         Next
    End If

推荐答案

您可能会发现使用 FileSystemObject 更容易，类似这样的事情

You might find it easier to use the FileSystemObject, somthing like this

这会将文件夹/文件列表转储到立即窗口

This dumps a folder/file list to the Immediate window

Option Explicit

Sub Demo()
    Dim fso As Object 'FileSystemObject
    Dim fldStart As Object 'Folder
    Dim fld As Object 'Folder
    Dim fl As Object 'File
    Dim Mask As String
    
    Set fso = CreateObject("scripting.FileSystemObject") ' late binding
    'Set fso = New FileSystemObject 'or use early binding (also replace Object types)
    
    Set fldStart = fso.GetFolder("C:YourStartFolder") '-- use your FileDialog code here

    Mask = "*.xls"
    Debug.Print fldStart.Path & ""
    ListFiles fldStart, Mask
    For Each fld In fldStart.SubFolders
        ListFiles fld, Mask
        ListFolders fld, Mask
    Next
End Sub


Sub ListFolders(fldStart As Object, Mask As String)
    Dim fld As Object 'Folder
    For Each fld In fldStart.SubFolders
        Debug.Print fld.Path & ""
        ListFiles fld, Mask
        ListFolders fld, Mask
    Next

End Sub

Sub ListFiles(fld As Object, Mask As String)
    Dim fl As Object 'File
    For Each fl In fld.Files
        If fl.Name Like Mask Then
            Debug.Print fld.Path & "" & fl.Name
        End If
    Next
End Sub

这篇关于循环浏览用户指定的根目录中的子文件夹和文件的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！