循環(huán)訪問用戶指定的根目錄中的子文件夾和文件我的循環(huán)腳本通過單個(gè)文件工作正常，但我現(xiàn)在需要它也查看/為多個(gè)目錄。我被困了....事情需要發(fā)生的事情：提示用戶選擇所需內(nèi)容的根目錄我需要腳本來查找該根目錄中的任何文件夾如果腳本找到一個(gè)，它會(huì)打開第一個(gè)（所有文件夾，因此文件夾沒有特定的搜索過濾器）打開后，我的腳本將遍歷文件夾中的所有文件并執(zhí)行它需要執(zhí)行的操作它完成后關(guān)閉文件，關(guān)閉目錄并移動(dòng)到下一個(gè)，等等。循環(huán)直到所有文件夾都被打開/掃描這就是我所擁有的，這是行不通的，我知道是錯(cuò)的：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最終守則。它循環(huán)遍歷每個(gè)子目錄中的所有子目錄和文件。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)
3 回答
慕沐林林
TA貢獻(xiàn)2016條經(jīng)驗(yàn) 獲得超9個(gè)贊
這是一個(gè)VBA解決方案，不使用外部對(duì)象。
由于Dir()函數(shù)的局限性，您需要一次獲取每個(gè)文件夾的全部內(nèi)容，而不是使用遞歸算法進(jìn)行爬網(wǎng)。
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添加回答
舉報(bào)
0/150
提交
取消