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

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

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

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