object variable not destroyed

[newsbin.telenet.be]

I want to open a new XL workbook and paste the recordset from a subform.
Then I want the user to close (and ev. save) the workbook.

Dim appXL As Excel.Application
Dim xlbook As Excel.Workbook
Dim rs As DAO.Recordset
Dim iCols As Integer
Set rs = Forms("frmPrijsEvol")("frmPrijsEvolsub").Form.RecordsetClone
Set appXL = New Excel.Application
With appXL
.Visible = True
Set xlbook = .Workbooks.Add()
.ActiveWindow.Caption = "Pasted from MS Access (" &
Application.CurrentObjectName & ") - " & .ActiveWindow.Caption
For iCols = 0 To rs.Fields.Count - 1
.Cells(1, iCols + 1).Value = rs.Fields(iCols).Name
Next
.Range(Cells(1, 1), Cells(1, rs.Fields.Count)).Font.Bold = True
.Range("A2").CopyFromRecordset rs
End With
Set appXL = Nothing

This works fine the 1st time.
When the code is activated a 2nd time Access gives runtime error 1004:
Method 'cells' of object _ global failed.
I suppose somewhere in my code the object variable is not explicitaly
declared and even if the user closes XL, the first instance keeps on
running.
Pleaese help me with the correct code.

Tks,
Michel

 

[MacDermott]

Instead of
Set appXL=New Excel.Application
Try using
Set appXL=GetObject(,"Excel.Application")
This will attach to an existing instance of Excel.
You'll want to trap the error that occurs if no instance exists;
I'd suggest using CreateObject in that case.

HTH

 

[Michel Peeters]

tks, I changed it as below. The error has gone but when the code is
executed a 2nd time only the first row from XL as visible.
The rest of the workbook looks exactly the same as my Access form (instead
off cells).
Please help - I spent hours on this and can't get it working. - Michel P.

Function IsExcelRunning() As Boolean
Dim xlApp As Excel.Application
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
IsExcelRunning = (Err.Number = 0)
Set xlApp = Nothing
Err.Clear
End Function

Private Sub cmdXLS_Click()
Dim appXL As Excel.Application
Dim xlbook As Excel.Workbook
Dim rs As DAO.Recordset
Dim iCols As Integer
Dim blnExcelRunning As Boolean
' Stop
Me.frmPrijsEvolSub.SetFocus
Me.frmPrijsEvolSub.SetFocus
Set rs = Forms("frmPrijsEvol")("frmPrijsEvolsub").Form.RecordsetClone
'rs op rs van subform zette
blnExcelRunning = IsExcelRunning()
If blnExcelRunning Then
Set appXL = GetObject(, "Excel.Application")
Else
Set appXL = CreateObject("Excel.Application")
End If
With appXL

Set xlbook = .Workbooks.Add()
.Visible = True
.ActiveWindow.Caption = "Pasted from MS Access (" &
Application.CurrentObjectName & ") - " & .ActiveWindow.Caption
For iCols = 0 To rs.Fields.Count - 1
.Cells(1, iCols + 1).Value = rs.Fields(iCols).Name
Next
.Range(Cells(1, 1), Cells(1, rs.Fields.Count)).Font.Bold =
True
.Range("A2").CopyFromRecordset rs
.UserControl = False
End With
If Not blnExcelRunning Then appXL.Quit
Set xlbook = Nothing
Set appXL = Nothing
Set rs = Nothing
End Sub

 

[Michel Peeters]

tks, I changed it as below. The error has gone but when the code is
executed a 2nd time only the first row from XL as visible.
The rest of the workbook looks exactly the same as my Access form (instead
off cells).
Please help - I spent hours on this and can't get it working. - Michel P.

Function IsExcelRunning() As Boolean
Dim xlApp As Excel.Application
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
IsExcelRunning = (Err.Number = 0)
Set xlApp = Nothing
Err.Clear
End Function

Private Sub cmdXLS_Click()
Dim appXL As Excel.Application
Dim xlbook As Excel.Workbook
Dim rs As DAO.Recordset
Dim iCols As Integer
Dim blnExcelRunning As Boolean
' Stop
Me.frmPrijsEvolSub.SetFocus
Me.frmPrijsEvolSub.SetFocus
Set rs = Forms("frmPrijsEvol")("frmPrijsEvolsub").Form.RecordsetClone
'rs op rs van subform zette
blnExcelRunning = IsExcelRunning()
If blnExcelRunning Then
Set appXL = GetObject(, "Excel.Application")
Else
Set appXL = CreateObject("Excel.Application")
End If
With appXL

Set xlbook = .Workbooks.Add()
.Visible = True
.ActiveWindow.Caption = "Pasted from MS Access (" &
Application.CurrentObjectName & ") - " & .ActiveWindow.Caption
For iCols = 0 To rs.Fields.Count - 1
.Cells(1, iCols + 1).Value = rs.Fields(iCols).Name
Next
.Range(Cells(1, 1), Cells(1, rs.Fields.Count)).Font.Bold =
True
.Range("A2").CopyFromRecordset rs
.UserControl = False
End With
If Not blnExcelRunning Then appXL.Quit
Set xlbook = Nothing
Set appXL = Nothing
Set rs = Nothing
End Sub

 

[Michel Peeters]

tks, I changed it as below. The error has gone but when the code is
executed a 2nd time only the first row from XL as visible.
The rest of the workbook looks exactly the same as my Access form (instead
off cells).
Please help - I spent hours on this and can't get it working. - Michel P.

Function IsExcelRunning() As Boolean
Dim xlApp As Excel.Application
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
IsExcelRunning = (Err.Number = 0)
Set xlApp = Nothing
Err.Clear
End Function

Private Sub cmdXLS_Click()
Dim appXL As Excel.Application
Dim xlbook As Excel.Workbook
Dim rs As DAO.Recordset
Dim iCols As Integer
Dim blnExcelRunning As Boolean
' Stop
Me.frmPrijsEvolSub.SetFocus
Me.frmPrijsEvolSub.SetFocus
Set rs = Forms("frmPrijsEvol")("frmPrijsEvolsub").Form.RecordsetClone
'rs op rs van subform zette
blnExcelRunning = IsExcelRunning()
If blnExcelRunning Then
Set appXL = GetObject(, "Excel.Application")
Else
Set appXL = CreateObject("Excel.Application")
End If
With appXL

Set xlbook = .Workbooks.Add()
.Visible = True
.ActiveWindow.Caption = "Pasted from MS Access (" &
Application.CurrentObjectName & ") - " & .ActiveWindow.Caption
For iCols = 0 To rs.Fields.Count - 1
.Cells(1, iCols + 1).Value = rs.Fields(iCols).Name
Next
.Range(Cells(1, 1), Cells(1, rs.Fields.Count)).Font.Bold =
True
.Range("A2").CopyFromRecordset rs
.UserControl = False
End With
If Not blnExcelRunning Then appXL.Quit
Set xlbook = Nothing
Set appXL = Nothing
Set rs = Nothing
End Sub