Question

我有一个文件夹，子文件夹及其文件。文件命名为Subfodlername-testType（11203-bcst）。我想根据testType名称从子文件夹中的文件中获取数据，并在excelform中写入数据并自动保存。为每个子文件夹做环路。我可以用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 TestR()

    Call Recurse(GetFolder)

End Sub

Answer 1

如果子文件夹中有子文件夹怎么办？

尝试使用循环文件来代替：

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的所有子文件夹中包含＆＃34; bcst＆＃34;的所有文件。在文件名中，比使用FileSystemObject

的递归快得多

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

1 个答案: