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

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

事情需要发生的顺序：

• 提示用户select他们需要的根目录
• 我需要脚本来查找根目录中的任何文件夹
• 如果脚本find一个，它将打开第一个（所有文件夹，所以没有特定的文件夹searchfilter）
• 一旦打开，我的脚本将遍历文件夹中的所有文件，并执行需要的操作
• 完成后closures文件，closures目录并移动到下一个目录等。
• 循环，直到所有文件夹已被打开/扫描

这是我的，这是行不通的，我知道是错的：

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 

最后的代码。 它遍历每个子目录中的所有子目录和文件。

 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 

Answer 1

您可能会发现使用FileSystemObject更容易，就像这样

这将文件夹/文件列表转储到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 

Answer 2

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

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

 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 Loop End Function Function 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 Loop End Function Sub 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 F End Sub 

Answer 3

 Sub MoFileTrongCacFolder() Dim FSO As Object, fld As Object, Fil As Object Dim fsoFile As Object Dim fsoFol As Object Dim fileName As String Dim folderPath As String Dim wbkCS As Object 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 End Sub