为什么我的代码不会打开多个文件vba

时间:2018-01-03 09:08:29

标签: excel vba excel-vba loops filesystemobject

我有一个代码,打算在文件路径中打开所有名为“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 个答案:

答案 0 :(得分:1)

这里有很多过度的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

但是假设你想让它易于阅读等等,我已经完成了代码并重新标记了你的对象等,以便a)区分vba特定的措辞和b)识别父/子一样的所有权:

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会清除这些内容。

答案 1 :(得分:0)

见你的陈述:

:
For Each subfolders In subfolders
:

显然,subfolders中只有一个对象subfolders

正如Variatus建议的那样,尝试为变量制定更好的命名政策。