Trouble with Access to Excel Automation 1

[Baggie]

Dear Forum members:

I'm having some trouble with Access to Excel automation. This site has been extremely helpful. I've searched for many a solution on this site and found many answers. Now I need to ask a specific question. I'll be as brief and to the point as possible.

Objective: Create a monthly Excel spreadsheet that takes data from Access and makes a new tab for every grouping (Pyramid) in the recordset. Then I wish to copy each Pyramid's records into the corresponding tab in Excel. I am working in Access 2000 and Excel 2000. I prefer DAO because I haven't learned ADO yet.

Below is the code I've written so far. Please see the red code and my bolded comments. I took the CopyFromRecordset method right out of Access help. But it's not working??? Perhaps I'm not setting the range right? Thanks in advance for your assistance.

Sub CreateXLSheets()
Dim db As Database
Dim rsID As Recordset
Dim rsXLData As Recordset
Dim strSQL As String
Dim strIDNo As String
Dim objXL As Object
Dim rngXL As Excel.Range

Set db = CurrentDb
Set objXL = New Excel.Application
'---Grab the Pyramid codes from recordset
strSQL = "SELECT DISTINCT Pyramid FROM qryAuditReportwDivCodes WHERE Pyramid = " & Chr(34) & "SUPHQ" & Chr(34)
Set rsID = db.OpenRecordset(strSQL, dbOpenDynaset)
strIDNo = rsID!Pyramid
objXL.SheetsInNewWorkbook = 1
objXL.Workbooks.Add

Do Until rsID.EOF
    strSQL = "SELECT EE, LastName, FirstName, Feb, Mar FROM qryAuditReportwDivCodes" & _
    " WHERE Pyramid = " & Chr(34) & strIDNo & Chr(34) & " ORDER BY EE ASC"
    Set rsXLData = db.OpenRecordset(strSQL, dbOpenDynaset)
    
    'put into an XL worksheet tab here

    objXL.ActiveSheet.Name = strIDNo

Set rngXL = objXL.ActiveSheet.Range("A1&quot
rngXL.CopyFromRecordset rsXLData
the code in red here is where I am hanging up I get
error 430 Class does not support Automation or does not support expected interface

objXL.Worksheets.Add
    objXL.Visible = True
    
    rsXLData.Close
    Set rsXLData = Nothing
    rsID.MoveNext
Loop
rsID.Close
Set rsID = Nothing
objXL.DisplayAlerts = False
objXL.ActiveWorkbook.Close
objXL.DisplayAlerts = True
objXL.Quit
Set objXL = Nothing
Set rngXL = Nothing
db.Close
Set db = Nothing
End Sub

<><
Note: I've noticed that in trying to manipulate Excel from Access that there are some things that work when coded in the Excel VBE but not in the Access VBE. Is it just me or have others had similar experiences? Thanks again!

 

[SkipVought]

Hi,

Try this...

Set rngXL = objXL.ActiveWorkbook.ActiveSheet.Range("A1")

Hope this helps Skip,
Skip@theofficeexperts.com

 

[Baggie]

Skip,
Thanks for your reply. Unfortunately I'm still getting Error '430' Class does not support Automation or does not support expected interface.

I'm still not sure if I'm setting the range object correctly (How can I tell?, it doesn't give an error at that line.) But the error occurs on the line where I attempt the CopyFromRecordset Method

Thanks much!

 

[SkipVought]

I would try NOT using Active anything (sheet workbook), but setting the xlSheet object using it when setting the xlRange.

Other than that, i am out of suggestions. Skip,
Skip@theofficeexperts.com

 

[RobBroekhuis]

I doubt the problem is with the range object assignment. But I know nil about getting data from record sets, so I'm no help either way...
Rob

 

[Baggie]

Rob, Skip
I bought a book called &quot;Access Cookbook&quot; chock full of sample code. It has a demonstration of a problem similar to mine here. I have to go to a meeting now for the rest of the day, but I'll start banging away again tomorrow. I'll let you know what happens if you're interested. This site has been so helpful to me, I'd like to contribute back if I can.

Adios!

 

[Baggie]

PROBLEM SOLVED!

It turns out that the CopyFromRecordset method will only work with an ADO recordset even though the help file includes DAO. In case anyone is interested here is a copy of the code that now works for me. The Access Cookbook was my major source of inspiration. I highly recommend the book as well as this wonderful website. Thanks to everyone who contributes!!

Sub CreateXLSheets2()
Dim rsID As ADODB.Recordset
Dim rsXLData As ADODB.Recordset
Dim strSQL As String
Dim strIDNo As String
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet

Set xlApp = New Excel.Application
'---Grab the Pyramid codes from recordset
strSQL = "SELECT DISTINCT Pyramid FROM qryAuditReportwDivCodes WHERE Pyramid = " & Chr(34) & "SUPHQ" & Chr(34)
Set rsID = New ADODB.Recordset
rsID.Open Source:=strSQL, ActiveConnection:=CurrentProject.Connection

strIDNo = rsID!pyramid
xlApp.SheetsInNewWorkbook = 1
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.ActiveSheet

Do Until rsID.EOF
    strSQL = "SELECT EE, LastName, FirstName, Feb, Mar FROM qryAuditReportwDivCodes" & _
    " WHERE Pyramid = " & Chr(34) & strIDNo & Chr(34) & " ORDER BY EE ASC"
    Set rsXLData = New ADODB.Recordset
    rsXLData.Open Source:=strSQL, ActiveConnection:=CurrentProject.Connection
    'put into an XL worksheet tab here
    xlSheet.Name = strIDNo
    xlSheet.Range("A2").CopyFromRecordset rsXLData
    
    
    xlBook.Worksheets.Add
    xlApp.Visible = True
    
    rsXLData.Close
    Set rsXLData = Nothing
    rsID.MoveNext
Loop
rsID.Close
Set rsID = Nothing
xlApp.DisplayAlerts = False
xlBook.Close
xlApp.DisplayAlerts = True
xlApp.Quit
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
End Sub

<-)