循环访问用户指定的根目录中的子文件夹和文件

Question

循环访问用户指定的根目录中的子文件夹和文件我的循环脚本通过单个文件工作正常，但我现在需要它也查看/为多个目录。我被困了....事情需要发生的事情：提示用户选择所需内容的根目录我需要脚本来查找该根目录中的任何文件夹如果脚本找到一个，它会打开第一个（所有文件夹，因此文件夹没有特定的搜索过滤器）打开后，我的脚本将遍历文件夹中的所有文件并执行它需要执行的操作它完成后关闭文件，关闭目录并移动到下一个，等等。循环直到所有文件夹都被打开/扫描这就是我所拥有的，这是行不通的，我知道是错的：MsgBox "Please choose the folder."Application.DisplayAlerts = FalseWith Application.FileDialog(msoFileDialogFolderPicker)     .InitialFileName = "\\blah\test\"     .AllowMultiSelect = False     If .Show <> -1 Then MsgBox "No folder selected! Exiting script.": Exit Sub     CSRootDir = .SelectedItems(1)End WithfolderPath = 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 DoLoop    'back to the Do最终守则。它循环遍历每个子目录中的所有子目录和文件。Dim FSO As Object, fld As Object, Fil As ObjectDim 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)

Answer 1

这是一个VBA解决方案，不使用外部对象。

由于Dir()函数的局限性，您需要一次获取每个文件夹的全部内容，而不是使用递归算法进行爬网。

Function GetFilesIn(Folder As String) As Collection  Dim F As String
  Set GetFilesIn = New Collection
  F = Dir(Folder & "\*")
  Do While F <> ""
    GetFilesIn.Add F
    F = Dir  LoopEnd FunctionFunction GetFoldersIn(Folder As String) As Collection  Dim F As String
  Set GetFoldersIn = New Collection
  F = Dir(Folder & "\*", vbDirectory)
  Do While F <> ""
    If GetAttr(Folder & "\" & F) And vbDirectory Then GetFoldersIn.Add F
    F = Dir  LoopEnd FunctionSub Test()
  Dim C As Collection, F

  Debug.Print
  Debug.Print "Files in C:\"
  Set C = GetFilesIn("C:\")
  For Each F In C
    Debug.Print F  Next F

  Debug.Print
  Debug.Print "Folders in C:\"
  Set C = GetFoldersIn("C:\")
  For Each F In C
    Debug.Print F  Next FEnd Sub