Excel VBA读写文件夹子文件夹及其文件

我有一个文件夹、子文件夹及其文件。文件的命名类似于子文件夹名称testType（11203 bcst）。我想根据testType名称从子文件夹中的文件中获取数据，并以Excel格式写入数据并自动保存。使用循环为每个子文件夹执行此操作。我可以用VBA吗

Function Recurse(sPath As String) As String

Dim FSO As New FileSystemObject
Dim myFolder As Folder
Dim mySubFolder As Folder
Dim myFile As File
Set myFolder = FSO.GetFolder(sPath)
Dim s As String

For Each mySubFolder In myFolder.SubFolders
    For Each myFile In mySubFolder.Files
        If InStr(myFile, "bcst") > 0 Then

            Dim sItem2 As String
            Dim sItem3 As String
            Dim sItem4 As String
            Dim sItem5 As String
            Dim sItem6 As String
            Dim sItem7 As String


            Application.ScreenUpdating = False
            Set ana = ThisWorkbook.Sheets("Sayfa1") 'Hangi sayfaya alınacak?
            Set dosya = Workbooks.Open(sPath) 'Alınacak dosyanın uzantısı ne?


            sItem2 = dosya.Sheets(ActiveSheet.Name).Range("A4")
            Dim indexOfChar As Integer
            indexOfChar = InStr(1, sItem2, ":")
            Dim finalString As String
            finalString = Right(sItem2, Len(sItem2) - indexOfChar)
            ana.Range("F7") = finalString & "." 'Hangi sayfanın hangi hücresi nereye alınacak?


            sItem3 = dosya.Sheets(ActiveSheet.Name).Range("A5")
            Dim indexOfChar2 As Integer
            indexOfChar2 = InStr(1, sItem3, ":")
            Dim finalString2 As String
            finalString2 = Right(sItem3, Len(sItem3) - indexOfChar2)
            MsgBox finalString
            ana.Range("F8") = finalString2 'Hangi sayfanın hangi hücresi nereye alınacak?

            sItem4 = dosya.Sheets(ActiveSheet.Name).Range("A7")
            Dim indexOfChar3 As Integer
            indexOfChar3 = InStr(1, sItem4, ":")
            Dim finalString3 As String
            finalString3 = Right(sItem4, Len(sItem4) - indexOfChar3)
            ana.Range("F9") = finalString3 'Hangi sayfanın hangi hücresi nereye alınacak?

            sItem5 = dosya.Sheets(ActiveSheet.Name).Range("A6")
            Dim indexOfChar4 As Integer
            indexOfChar4 = InStr(1, sItem5, ":")
            Dim finalString4 As String
            finalString4 = Right(sItem5, Len(sItem5) - indexOfChar4)
            ana.Range("F10") = finalString4 'Hangi sayfanın hangi hücresi nereye alınacak?

            sItem6 = dosya.Sheets(ActiveSheet.Name).Range("A8")
            Dim indexOfChar5 As Integer
            indexOfChar5 = InStr(1, sItem6, ":")
            Dim finalString5 As String
            finalString5 = Right(sItem6, Len(sItem6) - indexOfChar5)
            ana.Range("F11") = finalString5 'Hangi sayfanın hangi hücresi nereye alınacak?


            sItem7 = dosya.Sheets(ActiveSheet.Name).Range("A11")
            Dim indexOfChar6 As Integer
            indexOfChar6 = InStr(1, sItem7, ":")
            Dim finalString6 As String
            finalString6 = Right(sItem7, Len(sItem7) - indexOfChar6)
            ana.Range("F12") = finalString6 'Hangi sayfanın hangi hücresi nereye alınacak?






            dosya.Close
            Application.ScreenUpdating = True

            Exit For
        End If
    Next
    Recurse = Recurse(mySubFolder.Path)
Next

End Function

---

---

如果您的子文件夹中有子文件夹怎么办

请尝试以下方法来循环文件：

Sub LoopFromFolder(ByVal folderName As String)

    Dim file As Variant

    For Each file In Filter(Split(CreateObject("WScript.Shell").Exec("CMD /C DIR """ & folderName & "\*.*"" /S /A:-D /B").StdOut.ReadAll, vbCrLf), "bcst")
        '// Your code here
    Next
End Sub

---

这将遍历

folderName

所有子文件夹中文件名中包含“bcst”的所有文件，比对

FileSystemObject

使用递归要快得多。是的，您可能尝试了什么吗？可以。但是如果你想得到帮助的话，你需要向我们展示你迄今为止所做的尝试，并解释你在这个过程中遇到的困难。我尝试了yeap，但它实际上不起作用。我有一个文件夹，它有250个文件夹，每个文件夹中有四个文件。我想逐文件夹迭代，在每个文件夹中我读取文件，保存一个excel，然后转到另一个文件夹。这对我没有帮助我认为没有子文件夹我有主文件夹子文件夹和文件这仍然可以工作，即使只有一组子文件夹，仍然比使用

FileSystemObject

更快是的，我提供的代码只会循环通过文件名中有“bcst”的文件，但我需要不同的东西。我有一个主文件夹和子文件夹，每个子文件夹中有4个文件（123 bcst、123 pcpt、123 corsi、123 wcst），我想从这些文件中获取数据，bcst数据将写入book1 sheet1 A4，pcpt数据将写入A5。“for files”确定后，传递另一个子文件夹。我可以这样做吗？

Sub LoopFromFolder(ByVal folderName As String)

    Dim file As Variant

    For Each file In Filter(Split(CreateObject("WScript.Shell").Exec("CMD /C DIR """ & folderName & "\*.*"" /S /A:-D /B").StdOut.ReadAll, vbCrLf), "bcst")
        '// Your code here
    Next
End Sub