ACCESS errore metodo worksheets dell'oggetto global non riuscito

[Fabrizio Faccani]

Salve, ho questo problemino:
con il codice sottoindicato inserisco automaticamente dei dati in un foglio excel. Al primo giro tutto OK, ma se provo a fare successivamente un altro inserimento mi da' l'errore in oggetto. Ho scoperto (aprendo i processi in task manager) che praticamente non mi chiude la sessione excel ma se da task manager la chiudo io e faccio ripartire la routine tutto funziona!!!
Perchè non mi chiude la sessione? Da notare anche che se lo ripeto la TERZA volta l'errore non me lo da'!!!! Anzi mi chiude anche la seconda sessione di excel (ma una rimane sempre comunque aperta!!!). L'unico inconveniente è che non mi aggiorna il file di excel.
Ecco il codice e grazie per eventuali suggerimenti:

Private Sub R_EsportaExcel_Click()
On Error GoTo Err_R_EsportaExcel_Click
    
    Dim qdf As DAO.QueryDef
    Dim RecSet As DAO.Recordset
    
    Dim ExcelApp As Excel.Application
    Dim ExcelBook As Workbook
    
    
    If IsNull(Me!dal) Or IsNull(Me!fornitore) Or IsNull(Me!al) Or IsNull(Me!RCK) Or IsNull(Me!cantiere) Then
        mresponse = MsgBox("Inserire CANTIERE/FORNITORE/DAL AL/RCK", , "Manca parametro")
    Else
    
        Set db = CurrentDb
        Set qdf = db.QueryDefs("Query2")
        qdf.Parameters![dal] = Forms!main!dal
        qdf.Parameters![al] = Forms!main!al
        Set RecSet = qdf.OpenRecordset
        
        ' verifico che esistano dei dati da esportare in excel
        If RecSet.EOF = False Then
            ' Creo una nuova applicazione excel
            Set ExcelApp = New Excel.Application
            ' Aggiungo un workbook prelevato da un file
            Set ExcelBook = ExcelApp.Workbooks.Add(Application.CurrentProject.Path & "\Zello Colacem BASE.xls")
            ' attivo il foglio che interessa
            
            Worksheets("Rck25").Activate  'QUI DA ERRORE AL SECONDO GIRO
            
            Range("A10:C124").Select
            Selection.ClearContents
            Range("A9").Select
        
            ' ciclo di scrittura dei dati
            Dim mnumero As Integer
            mnumero = 1
            While RecSet.EOF = False
                ' scrivo la data
                ActiveCell.Value = RecSet!DataPrel
                ' scrivo il progressivo
                ActiveCell.Offset(0, 1).Value = mnumero
                ' scrivo l'rm
                ActiveCell.Offset(0, 2).Value = RecSet!rm
                ActiveCell.Offset(1, 0).Activate
                RecSet.MoveNext 'avanzo di un record
                mnumero = mnumero + 1
            Wend
           
           'salvo il file e chiudo tutto
           ExcelBook.SaveAs "c:\prova.xls"
           ExcelApp.Workbooks("prova.xls").Close
           ExcelApp.Quit
           Set ExcelApp = Nothing
           Set ExcelBook = Nothing
           
        End If
        RecSet.Close
        qdf.Close
        db.Close
    End If

Exit_R_EsportaExcel_Click:
    Exit Sub

Err_R_EsportaExcel_Click:
    MsgBox Err.Description
    Resume Exit_R_EsportaExcel_Click

End Sub