Question

借助此处以前的一些问题，我能够编写代码在多个子文件夹中搜索具有特定名称的文件。

我有一个包含多个子文件夹的文件夹，并且某些子文件夹还包含更多子文件夹。我找到的代码搜索所有这些子文件夹以及子子文件夹。但我希望我的代码仅搜索子文件夹，即只有第一层。

有人可以帮我吗？

Function Recurse(sPath As String) As String

Dim FSO As New FileSystemObject
Dim myFolder As Folder
Dim mySubFolder As Folder
Dim mySubSubFolder As Folder
Dim myFile As File
Dim Path As String
Dim f As Integer
Dim i As Integer
Dim j As Integer
Set myFolder = FSO.GetFolder(sPath)
Dim myComp

For Each mySubFolder In myFolder.SubFolders

    f = -1

    For Each myFile In mySubFolder.Files

        If ((InStr(myFile.Name, "Beurteilungsblatt") > 0) And (InStr(myFile.Name, ".xlsm") > 0)) Then
            Debug.Print (myFile.Name)
            f = f + 1
        End If
    Next

    Dim arr()
    ReDim arr(f)

    i = 0
        For Each myFile In mySubFolder.Files
            If ((InStr(myFile.Name, "Beurteilungsblatt") > 0) And (InStr(myFile.Name, ".xlsm") > 0)) Then
                Workbooks.Open (myFile.Path)
                Set wbok1Current = ActiveWorkbook
                arr(i) = wbok1Current.Worksheets("Beurteilungsblatt").Range("FK10")
                i = i + 1
                wbok1Current.Close
            End If
        Next

    For j = 0 To f - 1
        Dim str As String
        Dim str1 As String
        str = arr(j)
        str1 = arr(j + 1)
        myComp = StrComp(str, str1, 1)
        If (myComp = 0) Then
            GoTo Continuej
        Else
            MsgBox ("Die Beurteilungsblätter sind nicht von selben Fahrzeug!" & vbCrLf & "Please Check " & str & " and " & str1 & ".")
            GoTo NextFolder
        End If
Continuej:
    Next j

    For Each myFile In mySubFolder.Files

        If ((InStr(myFile.Name, "Beurteilungsblatt") > 0) And (InStr(myFile.Name, ".xlsm") > 0)) Then

          '  MsgBox myFile.Name & " in " & myFile.path 'Or do whatever you want with the file
          '  Exit For


                Workbooks.Open (myFile.Path)
                Set wbok1Current = ActiveWorkbook


                If (IsRangeEmpty(Range("CR10:EY10")) And wbok1Current.Worksheets("Beurteilungsblatt").Range("EZ10").Value = "0" And wbok1Current.Worksheets("Beurteilungsblatt").Range("FA10").Value = "0" And wbok1Current.Worksheets("Beurteilungsblatt").Range("FB10").Value = "0" And wbok1Current.Worksheets("Beurteilungsblatt").Range("FJ10").Value = "") Then
                    GoTo ContinueDo
                End If

                Path = wbok1Current.Path

    ' do something


ContinueDo:
                    wbok1Current.Close
                    wbokCurrent.Activate

        End If

    Next
    Recurse = Recurse(mySubFolder.Path)

    wbokCurrent.Activate
    Dim dateinam As String
    dateinam = Worksheets("Fahrzeug").Range("CC2").Value
    If dateinam = "" Then
        Exit Function
    Else
    Application.DisplayAlerts = False
'    wbokCurrent.SaveAs Filename:=ThisWorkbook.Path & "\Auswertung_" & dateinam & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
    wbokCurrent.SaveCopyAs FileName:=Path & "\" & dateinam & ".xlsm" 'FileFormat:=xlOpenXMLWorkbookMacroEnabled
    Application.DisplayAlerts = True
    End If
    Range("A13:CD53").Select                'Löschen
    Application.CutCopyMode = False         'Löschen
    Selection.ClearContents                 'Löschen
    Range("A13").Select                     'Löschen

NextFolder:

Next

结束功能

如何在多个子文件夹中搜索文件？

0 个答案: