循环访问用户指定的根目录中的子文件夹和文件
我的循环脚本通过单个文件工作正常,但我现在需要它也查看/为多个目录。我被困了....
事情需要发生的事情:
提示用户选择所需内容的根目录
我需要脚本来查找该根目录中的任何文件夹
如果脚本找到一个,它会打开第一个(所有文件夹,因此文件夹没有特定的搜索过滤器)
打开后,我的脚本将遍历文件夹中的所有文件并执行它需要执行的操作
它完成后关闭文件,关闭目录并移动到下一个,等等。
循环直到所有文件夹都被打开/扫描
这就是我所拥有的,这是行不通的,我知道是错的:
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)
白衣非少年