Импорт листов Excel 97-2003 в активную книгу

Question

Следующий код импортирует файлы 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:\Users\francisca.cambra\Dropbox\Faculdade\Thesis\MS-Project\MacroTest\"
    fName = Dir(fPath & "*.xlsx")
    Do While fName <> ""
        Set currentWB = Workbooks.Open(Filename:=fPath & 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 & "*.xlsx") на fName = Dir(fPath & "*.xls"), рабочая книга становится пустой, без макросов и данных.

Макрос импортирует файлы Excel 97-2003, когда я комментирую строку currentWB.Close SaveChanges:=False, и копирует дважды первую полученную книгу Excel. Я думаю, что текущая ББ - однажды ActiveBook, и когда макрос запускается, ActiveBook закрывается, но я не знаю, почему, поскольку ActiveBook имеет расширение, отличное от других, поэтому цикл не должен хранить ActiveBook.

Answer 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:\Users\francisca.cambra\Dropbox\Faculdade\Thesis\MS-Project\MacroTest\"
    fName = Dir(fPath & "*.xls")
    Do While fName <> ""
        If fName <> "Blank.xlsm.xlsm" Then
            Set currentWB = Workbooks.Open(Filename:=fPath & 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