#excel #vba
#excel #vba
Вопрос:
Следующий код импортирует файлы Excel («.xlsx») по определенному пути в мою активную рабочую книгу.
Sub GetSheets1()
Application.ScreenUpdating = False
Dim fPath As String, fName As String
Dim destWB As Workbook, currentWB As Workbook
Dim i As Long
Set destWB = ActiveWorkbook
fPath = "C:Usersfrancisca.cambraDropboxFaculdadeThesisMS-ProjectMacroTest"
fName = Dir(fPath amp; "*.xlsx")
Do While fName <> ""
Set currentWB = Workbooks.Open(Filename:=fPath amp; fName, ReadOnly:=True)
For i = 1 To currentWB.Sheets.Count
currentWB.Sheets(i).Copy After:=destWB.Sheets(destWB.Sheets.Count)
Next i
currentWB.Close SaveChanges:=False
fName = Dir()
Loop
Application.ScreenUpdating = True
Sheets("Sheet1").Select
End Sub
Для файлов Excel 97-2003, когда я меняю fName = Dir(fPath amp; "*.xlsx")
на fName = Dir(fPath amp; "*.xls")
, рабочая книга становится пустой, без макросов и данных.
Макрос импортирует файлы Excel 97-2003, когда я комментирую currentWB.Close SaveChanges:=False
строку, и он дважды копирует первую полученную книгу Excel. Я думаю, что currentWB когда-то был ActiveBook, и когда запускается макрос, ActiveBook закрывается, но я не знаю почему, поскольку ActiveBook имеет расширение, отличное от других, поэтому цикл не должен сохранять ActiveBook.
Комментарии:
1. Очень странно. Я не могу воспроизвести эту ошибку. У меня код работает нормально. Возможно ли, что один из ваших файлов .xls содержит макросы, которые создают помехи?
2. В этих файлах нет никаких макросов… Я действительно не знаю, что не так.
3. Можете ли вы отлаживать и пошагово просматривать свой код и обнаруживать, когда он выходит из строя? Попробуйте выполнить это только с одним файлом .xls, возможно, с одним рабочим листом. Содержат ли рабочие книги какие-либо другие типы листов, кроме просто Worksheet? Вы также можете попробовать скопировать некоторые листы вручную, чтобы проверить, не возникает ли ошибка.
4. Спасибо @AndyG, я уже решил проблему после больших усилий…
Ответ №1:
Решено 🙂
Sub GetSheets1()
Application.ScreenUpdating = False
Dim fPath As String, fName As String
Dim destWB As Workbook, currentWB As Workbook
Dim i As Long
Set destWB = ActiveWorkbook
fPath = "C:Usersfrancisca.cambraDropboxFaculdadeThesisMS-ProjectMacroTest"
fName = Dir(fPath amp; "*.xls")
Do While fName <> ""
If fName <> "Blank.xlsm.xlsm" Then
Set currentWB = Workbooks.Open(Filename:=fPath amp; fName)
For i = 1 To currentWB.Sheets.Count
currentWB.Sheets(i).Copy After:=destWB.Sheets(destWB.Sheets.Count)
Next i
currentWB.Close SaveChanges:=False
End If
fName = Dir()
Loop
Application.ScreenUpdating = True
Sheets("Sheet1").Select
End Sub