Fabrizio Faccani
20-05-2008, 08:45
Riposto. Proprio nessuno sa darmi una mano? :cry:
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
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