循环遍历文件夹的各个子文件夹以及这些子文件夹的每个文件时出现问题

Question

我想访问我当前文件夹的每个子文件夹（每个子文件夹中的子文件夹数量可能会有所不同），然后想在所有这些子文件夹的每个 excel 工作簿中执行一些操作。

下面提到的是代码，代码不会引发编译时错误但无法正常工作。请帮帮我

option explicit
Sub LoopFolders()
    Dim strFolder As String
    Dim strSubFolder As String
    Dim strFile As String
    Dim colSubFolders As New Collection
    Dim varItem As Variant
    Dim wbk As Workbook
    ' Parent folder including trailing backslash
    strFolder = "C:\Users\Yashika Vaish\Desktop\yashika\"
    ' Loop through the subfolders and fill Collection object
    strSubFolder = Dir(strFolder & "*", vbDirectory)
    Do While Not strSubFolder = ""
        Select Case strSubFolder
            Case ".", ".."
                ' Current folder or parent folder - ignore
            Case Else
                ' Add to collection
                colSubFolders.Add Item:=strSubFolder, Key:=strSubFolder
        End Select
        ' On to the next one
        strSubFolder = Dir
    Loop
    ' Loop through the collection
    For Each varItem In colSubFolders
        ' Loop through Excel workbooks in subfolder
        strFile = Dir(strFolder & varItem & "\*.xls*")
        Do While strFile <> ""
            ' Open workbook
            Set wbk = Workbooks.Open(FileName:=strFolder & _
                varItem & "\" & strFile, AddToMRU:=False)
           MsgBox "I am open"

            strFile = Dir
        Loop
    Next varItem
End Sub

工具设置中所有必需的引用都已添加到此 VBA 项目中。请帮我处理这段代码。

Answer 1

这是我使用的，它是经过#WorksAtMyBox 认证的代码；）

Option Explicit
Dim fso As Scripting.FileSystemObject
Dim fsoMainDirectory As Scripting.folder
Dim fsoSubfolder As Scripting.folder
Dim fsoFile As Scripting.file
Dim strFilePath
Dim filecounter As Long
Dim foldercounter As Long


Public Sub FileFinder(fileorfolder As String)

    If fso Is Nothing Then
        Set fso = New Scripting.FileSystemObject
    End If


    Set fsoMainDirectory = fso.GetFolder(fileorfolder)
    If fsoMainDirectory.SubFolders.Count > 0 Then
        For Each fsoSubfolder In fsoMainDirectory.SubFolders
            foldercounter = foldercounter + 1
            Debug.Print "Folder: " & foldercounter & fsoSubfolder.Path
            FileFinder (fsoSubfolder.Path)
        Next fsoSubfolder
    End If

    If fsoMainDirectory.Files.Count > 0 Then
        For Each fsoFile In fsoMainDirectory.Files
            ProcessFile (fsoFile.Path)
        Next fsoFile
    End If



End Sub

Public Sub ProcessFile(file As String)
    filecounter = filecounter + 1
    Debug.Print "File: " & filecounter & ": " & file
End Sub

Answer 2

所以，这是我在文件夹中搜索特定文件类型的方法。 （在开发阶段，早期绑定是您的朋友）。确保您启用了 Microsoft 脚本运行时参考。

Option Explicit
Sub test()
Dim fso As Scripting.FileSystemObject
Dim fsoMainDirectory As Scripting.Folder
Dim fsoSubfolder As Scripting.Folder
Dim fsoFile As Scripting.File
Dim strFilePath

Set fso = New Scripting.FileSystemObject
Set fsoMainDirectory = fso.GetFolder("Directory, with trailing \")

For Each fsoFile In fsoMainDirectory.Files
    If fsoFile.Type = "Microsoft Excel 97-2003 Worksheet" Then '.xls file type
        strFilePath = fsoFile.Path
        Application.Workbooks.Open strFilePath
    End If
Next fsoFile
End Sub

您的子文件夹有多深？你是唯一一个会使用这个宏的人吗？循环遍历具有未知数量子文件夹的 n 个子文件夹是可行的，但我的方法涉及一组计数器。这个数组可能会降低性能，因此如果我们不需要，我们不想这样做。

Answer 3

下面的方法也将子文件夹中的文件名写入工作簿。所以它会找到它们。

Sub Program()
    Dim i As Integer
    i = 1
    listFiles "D:\Folder 1", i
End Sub

Sub listFiles(ByVal sPath As String, ByRef i As Integer)
    Dim vaArray     As Variant
    Dim oFile       As Object
    Dim oFSO        As Object
    Dim oFolder     As Object
    Dim oFiles      As Object

    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oFolder = oFSO.GetFolder(sPath)
    Set oFiles = oFolder.Files

    If (oFiles.Count > 0) Then
        ReDim vaArray(1 To oFiles.Count)
        For Each oFile In oFiles
            Cells(i, "A").Value = oFile.Name
            Cells(i, "B").Value = oFile.Path
            i = i + 1
        Next
    End If

    listFolders sPath, i
End Sub

Sub listFolders(ByVal sPath As String, ByRef i As Integer)
    Dim vaArray     As Variant
    Dim oFile       As Object
    Dim oFSO        As Object
    Dim oFolder     As Object
    Dim oFiles      As Object

    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oFolder = oFSO.GetFolder(sPath)
    Set oFiles = oFolder.subfolders

    If (oFiles.Count > 0) Then
        ReDim vaArray(1 To oFiles.Count)
        For Each oFile In oFiles
            listFiles oFile.Path, i
            i = i + 1
        Next
    End If
End Sub