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

问题描述

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

订单需要发生：

• 用户被提示选择他们需要的根目录


• 我需要该脚本来查找根目录中的任何文件夹


• 如果脚本找到一个，它打开第一个（所有文件夹，所以没有具体的搜索过滤器的文件夹）


• 一旦打开，我的脚本将循环访问文件夹中的所有文件，并做所需要的要完成


• 关闭文件，关闭目录并移动到下一个等。


• 循环直到所有文件夹都有已经打开/扫描

这是我有的，这不工作，我知道是错误的：

  MsgBox请选择文件夹。 
 Application.DisplayAlerts = False 
 With Application.FileDialog（msoFileDialogFolderPicker）
 .InitialFileName =\\\Blah\test\
 .AllowMultiSelect = False 
如果.Show<> -1 Then MsgBoxNo 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）
如果folderPath<> False然后
 Do While fileName<> 
 Application.ScreenUpdating = False 
设置wbkCS = Workbooks.Open（folderPath& fileName）
 
  - 这里的文件循环脚本
 
循环返回到$ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $它循环遍历每个子目录中的所有子目录和文件。 
  Dim FSO As Object，fld As Object，Fil As Object 
 Dim fsoFile As Object 
 Dim fsoFol作为对象
 Dim fileName As String 
 
 MsgBox请选择文件夹。 
 Application.DisplayAlerts = False 
 With Application.FileDialog（msoFileDialogFolderPicker）
 .InitialFileName =\\\Blah\test\
 .AllowMultiSelect = False 
如果.Show<> -1 Then MsgBoxNo folder selected！Exiting script。：Exit Sub 
 folderPath = .SelectedItems（1）
 End with 
 
 If Right（folderPath，1）< > \然后folderPath = folderPath +\
设置FSO = CreateObject（Scripting.FileSystemObject）
设置fld = FSO.getfolder（folderPath）
如果FSO.folderExists（ fld）然后
对于每个fsoFol在FSO.getfolder（folderPath）.subfolders 
对于每个fsoFile在fsoFol.Files 
如果中间（fsoFile.Name，InStrRev（fsoFile.Name，。 ）+ 1）=xls然后
 fileName = fsoFile.Name 
 Application.ScreenUpdating = False 
设置wbkCS = Workbooks.Open（fsoFile.Path）
 
 '我的文件处理代码
 
 
结束如果
下一个
下一个
结束如果
  
 
 
解决方案
您可能会发现使用 FileSystemObject 更容易， 
 
 
 
这将文件夹/文件列表转储到立即窗口 
  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 
 
设置fso = CreateObject（scripting.FileSystemObject）'晚期绑定
'设置fso =新建FileSystemObject'或使用早期绑定（也可替换对象类型）
 
设置fldStart = fso.GetFolder （C：\Your\Start\Folder）'<  - 在这里使用你的FileDialog代码
 
 Mask =* .xls
 Debug.Print fldStart.Path &安培; \
 ListFiles fldStart，Mask 
对于每个fld在fldStart.SubFolders 
 ListFiles fld，Mask 
 ListFolders fld，Mask 
下一个
 End Sub 
 
 
 Sub ListFolders（fldStart As Object，Mask As String）
 Dim fld As Object'folder 
 For fldStart.SubFolders 
 Debug。打印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 
如果fl.Name Like Mask Then 
 Debug.Print fld.Path& \& fl.Name 
 End If 
 Next 
 End Sub 
  
 
My cycling script through individual files works fine, but I now need it to also look through/for multiple directories. I am stuck....

The order things need to happen:


User is prompted to choose root directory of what they need
I need the script to look for any folders in that root directory
If the script finds one, it opens the first one (all folders, so no specific search filter for the folders)
Once open, my script will loop through all files in the folders and do what it needs to do
after it's finished it closes the file, closes the directory and moves to the next one, etc..
Loops until all folders have been opened/scanned


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\test\"
    .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\test\"
         .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

解决方案
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:\Your\Start\Folder") ' <-- 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屋！