我通过各个文件的循环脚本工作正常,但我现在还需要它来查找多个目录。我被困住了......
事情发生的顺序:
- 提示用户选择他们需要的根目录
- 我需要脚本来查找该根目录中的任何文件夹
- 如果脚本找到一个,它将打开第一个(所有文件夹,因此没有针对文件夹的特定搜索过滤器)
- 打开后,我的脚本将循环遍历文件夹中的所有文件并执行其需要执行的操作
- 完成后,它会关闭文件,关闭目录并移至下一个,等等。
- 循环直到所有文件夹都已打开/扫描
这就是我所拥有的,它不起作用,而且我知道这是错误的:
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
您可能会发现使用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
本文内容由网友自发贡献,版权归原作者所有,本站不承担相应法律责任。如您发现有涉嫌抄袭侵权的内容,请联系:hwhale#tublm.com(使用前将#替换为@)