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

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

我的循环脚本通过单个文件工作正常,但我现在需要它也查看/为多个目录。我被困了....

事情需要发生的事情:

  • 提示用户选择所需内容的根目录

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

  • 如果脚本找到一个,它会打开第一个(所有文件夹,因此文件夹没有特定的搜索过滤器)

  • 打开后,我的脚本将遍历文件夹中的所有文件并执行它需要执行的操作

  • 它完成后关闭文件,关闭目录并移动到下一个,等等。

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

这就是我所拥有的,这是行不通的,我知道是错的:

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)


侃侃无极
浏览 666回答 3
3回答

白衣非少年

这是一个VBA解决方案,不使用外部对象。由于Dir()函数的局限性,您需要一次获取每个文件夹的全部内容,而不是使用递归算法进行爬网。Function&nbsp;GetFilesIn(Folder&nbsp;As&nbsp;String)&nbsp;As&nbsp;Collection&nbsp;&nbsp;Dim&nbsp;F&nbsp;As&nbsp;String &nbsp;&nbsp;Set&nbsp;GetFilesIn&nbsp;=&nbsp;New&nbsp;Collection &nbsp;&nbsp;F&nbsp;=&nbsp;Dir(Folder&nbsp;&&nbsp;"\*") &nbsp;&nbsp;Do&nbsp;While&nbsp;F&nbsp;<>&nbsp;"" &nbsp;&nbsp;&nbsp;&nbsp;GetFilesIn.Add&nbsp;F &nbsp;&nbsp;&nbsp;&nbsp;F&nbsp;=&nbsp;Dir&nbsp;&nbsp;LoopEnd&nbsp;FunctionFunction&nbsp;GetFoldersIn(Folder&nbsp;As&nbsp;String)&nbsp;As&nbsp;Collection&nbsp;&nbsp;Dim&nbsp;F&nbsp;As&nbsp;String &nbsp;&nbsp;Set&nbsp;GetFoldersIn&nbsp;=&nbsp;New&nbsp;Collection &nbsp;&nbsp;F&nbsp;=&nbsp;Dir(Folder&nbsp;&&nbsp;"\*",&nbsp;vbDirectory) &nbsp;&nbsp;Do&nbsp;While&nbsp;F&nbsp;<>&nbsp;"" &nbsp;&nbsp;&nbsp;&nbsp;If&nbsp;GetAttr(Folder&nbsp;&&nbsp;"\"&nbsp;&&nbsp;F)&nbsp;And&nbsp;vbDirectory&nbsp;Then&nbsp;GetFoldersIn.Add&nbsp;F &nbsp;&nbsp;&nbsp;&nbsp;F&nbsp;=&nbsp;Dir&nbsp;&nbsp;LoopEnd&nbsp;FunctionSub&nbsp;Test() &nbsp;&nbsp;Dim&nbsp;C&nbsp;As&nbsp;Collection,&nbsp;F &nbsp;&nbsp;Debug.Print &nbsp;&nbsp;Debug.Print&nbsp;"Files&nbsp;in&nbsp;C:\" &nbsp;&nbsp;Set&nbsp;C&nbsp;=&nbsp;GetFilesIn("C:\") &nbsp;&nbsp;For&nbsp;Each&nbsp;F&nbsp;In&nbsp;C &nbsp;&nbsp;&nbsp;&nbsp;Debug.Print&nbsp;F&nbsp;&nbsp;Next&nbsp;F &nbsp;&nbsp;Debug.Print &nbsp;&nbsp;Debug.Print&nbsp;"Folders&nbsp;in&nbsp;C:\" &nbsp;&nbsp;Set&nbsp;C&nbsp;=&nbsp;GetFoldersIn("C:\") &nbsp;&nbsp;For&nbsp;Each&nbsp;F&nbsp;In&nbsp;C &nbsp;&nbsp;&nbsp;&nbsp;Debug.Print&nbsp;F&nbsp;&nbsp;Next&nbsp;FEnd&nbsp;Sub
打开App,查看更多内容
随时随地看视频慕课网APP