Почему мой код не открывает несколько файлов 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
,
Как предполагает Вариатус, попытайтесь применить лучшую политику именования для ваших переменных.