Почему мой код не открывает несколько файлов VBA

У меня есть код, который должен открывать все файлы с именем "effect00*" в пути к файлу, однако он открывает только первый найденный файл, но я хочу, чтобы он открывал их все. Кто-нибудь знает, почему мой код этого не делает?

Мой код:

Sub LoopSubfoldersAndFiles()
Dim fso As Object
Dim Folder As Object
Dim subfolders As Object
Dim MyFile As String
Dim wb As Workbook
Dim CurrFile As Object

With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
End With

Set fso = CreateObject("Scripting.FileSystemObject")
Set Folder = fso.GetFolder("\\My Documents\Output files\analysis-tool-development")
Set subfolders = Folder.subfolders
MyFile = "effect00*.dat"

For Each subfolders In subfolders

Set CurrFile = subfolders.Files

    For Each CurrFile In CurrFile
        If CurrFile.Name Like MyFile Then
            Set wb = Workbooks.Open(subfolders.Path & "\" & MyFile)
        End If
    Next

Next

Set fso = Nothing
Set Folder = Nothing
Set subfolders = Nothing

With Application
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
End With

End Sub

2 ответа

Решение

Там очень многоSetЭто происходит для облегчения чтения, но в большинстве случаев не нужно. Например, так как вы не используете свой Folder Объект, отличный от затем получить подпапки, вместо:

Set Folder = fso.GetFolder("\\My Documents\Output files\analysis-tool-development")
Set subfolders = Folder.subfolders

Вы могли бы просто:

Set subfolders = fso.GetFolder("\\My Documents\Output files\analysis-tool-development").subfolders

Но, предполагая, что вы хотите, чтобы его было легко читать и т. Д., Я просмотрел код и переименовал ваши объекты и т. Д., Чтобы а) провести различие между конкретной формулировкой vba и б) идентифицировать родителя / ребенка как владение:

Sub LoopSubfoldersAndFiles()
    Dim fso As Object
    Dim myTopFolder As Object
    Dim mySubFolders As Object
    Dim mySingleFolder As Object
    Dim myFileCollection As Object
    Dim mySingleFile As Object
    Dim myFilePattern As String
    Dim wb As Workbook

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set myTopFolder = fso.GetFolder("\\My Documents\Output files\analysis-tool-development")
    Set mySubFolders = myTopFolder.subfolders
    myFilePattern = "effect00*.dat"

    For Each mySingleFolder In mySubFolders

    Set myFileCollection = mySingleFolder.Files

        For Each mySingleFile In myFileCollection
            If mySingleFile.Name Like myFilePattern Then
                Set wb = Workbooks.Open(mySingleFolder.Path & "\" & mySingleFile.Name)
            End If
        Next

    Next

    Set fso = Nothing
    Set myTopFolder = Nothing
    Set mySubFolders = Nothing
    Set mySubFolders = Nothing
    Set mySingleFolder = Nothing
    Set myFileCollection = Nothing
    Set mySingleFile = Nothing

    With Application
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
End Sub

Наконец, я оставил их, но есть блок Set xxx = Nothing что многие утверждают, не является необходимым. Это выглядит опрятно / аккуратно, но я помню, что читал где-то End Sub все равно очистит их.

Смотрите ваше заявление:

:
For Each subfolders In subfolders
:

Очевидно, есть один и только один объект subfolders в subfolders,

Как предполагает Вариатус, попытайтесь применить лучшую политику именования для ваших переменных.

Другие вопросы по тегам