Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations SkipVought on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Error 430 when using copy recordset

Status
Not open for further replies.

icewiper

Technical User
Apr 8, 2005
30
0
0
US
Hello all,

I have going crazy trying to figure this one out. I have used the copy record set many times and it has worked. Now for some reason I can not get past the copy recordset without getting that error 430. If I give the range an absolute value it will populate the excel sheet and work properly. I have checked my references and they have not changed.
Microsoft DAO 3.6 Object Library
Microsoft ActiveX Data Objects 2.7 Library
Microsoft ActiveX Data Objects Recordset 2.7 Library
Microsoft Excel 11.0 Object Library
for the key ones

Below is a copy of my code. Again it was working before but not now. Any help would be greatly appreciated

Code:
    Dim xlApp As Object
    Dim xlBook As Object
    Dim xlSheet As Object
    Dim X As Integer
    Dim ddbase As Database
    Dim rs As Object
    Dim sql As String
    Dim GetMonth As Integer
    Dim SiteBox As String
    Dim myolapp As Object
    Dim myItem As Variant
    Dim olMailTem As Variant

sql = "SELECT tblProperty.GPNbr, tblProperty.Category, tblProperty.Description,"
sql = sql & " tblProperty.UI, tblProperty.SN, tblProperty.AssignedPerson, tblProperty.RecDate,"
sql = sql & " tblProperty.TurnInDate, tblProperty.SiteID, tblProperty.TransferSite,"
sql = sql & " tblProperty.CatID, tblProperty.Comments, tblProperty.Status"
sql = sql & " FROM tblProperty;"

Set ddbase = CurrentDb
Set rs = ddbase.OpenRecordset(sql, dbOpenSnapshot)

Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets(1)

xlSheet.Activate
Sheets("Sheet1").Name = "Property"
For X = 0 To rs.Fields.Count - 1
xlSheet.Cells(1, X + 1).Value = rs.Fields(X).Name
Next

xlApp.Range("A2").CopyFromRecordset rs
xlSheet.Cells.Select
xlSheet.Cells.EntireColumn.AutoFit
xlSheet.Columns("A:I").Select
xlApp.Selection.EntireColumn.Hidden = True
xlApp.Worksheets("Sheet2").Delete
xlApp.Worksheets("Sheet3").Delete
xlSheet.Cells(3, 11).Value = "This is proprietary information. Please only import this into your property database."
xlSheet.Protect PassWord:="escape"
xlApp.ActiveWorkbook.Protect PassWord:="escape"

xlApp.ActiveWorkbook.SaveAs FileName:="C:\Documents and Settings\" & fOSUserName & "\My Documents\PMOProperty" & Format(Now(), "mmddyyyyhnn") & ".xls "

 


The Cell reference's PARENT is a WORKSHEET and NOT the Application Object.

What SHEET is A1 in? Include the sheet reference.
Code:
xlApp.workbooks(1).Worksheets(1).Range("A2").CopyFromRecordset rs


Skip,
[sub]
[glasses] [red][/red]
[tongue][/sub]
 
thank you i did try your suggestion but still the same error. I do understand about the reference to worksheet. we have been trying all options. But still the same error. It only happens with the copy recordset. here is the changed code as mentioned with your suggestion.

Code:
    Dim xlApp As Object
    Dim X As Integer
    Dim ddbase As Database
    Dim rs As Recordset
    Dim sql As String
    Dim GetMonth As Integer
    Dim SiteBox As String
    Dim myolapp As Object
    Dim myItem As Variant
    Dim olMailTem As Variant

sql = "SELECT tblProperty.GPNbr, tblProperty.Category, tblProperty.Description,"
sql = sql & " tblProperty.UI, tblProperty.SN, tblProperty.AssignedPerson, tblProperty.RecDate,"
sql = sql & " tblProperty.TurnInDate, tblProperty.SiteID, tblProperty.TransferSite,"
sql = sql & " tblProperty.CatID, tblProperty.Comments, tblProperty.Status"
sql = sql & " FROM tblProperty;"

Set ddbase = CurrentDb
Set rs = ddbase.OpenRecordset(sql, dbOpenSnapshot)

Set xlApp = CreateObject("Excel.Application")
xlApp.Workbooks.Add

xlApp.Worksheets(1).Activate
xlApp.Sheets("Sheet1").Name = "Property"
For X = 0 To rs.Fields.Count - 1
xlApp.Cells(1, X + 1).Value = rs.Fields(X).Name
Next

xlApp.Workbooks(1).Worksheets(1).Range("A2").Value = "123"    ' .CopyFromRecordset rs
xlApp.Cells.Select
xlApp.Cells.EntireColumn.AutoFit
xlApp.Columns("A:I").Select
xlApp.Selection.EntireColumn.Hidden = True
xlApp.Worksheets("Sheet2").Delete
xlApp.Worksheets("Sheet3").Delete
xlApp.Cells(3, 11).Value = "This is proprietary information. Please only import this into your property database."
xlApp.Worksheets(1).Protect PassWord:="escape"
xlApp.ActiveWorkbook.Protect PassWord:="escape"

xlApp.ActiveWorkbook.SaveAs FileName:="C:\Documents and Settings\kda1849\My Documents\PMOProperty" & Format(Now(), "mmddyyyyhnn") & ".xls "

i added the .Value = "123" in place of the .CopyFromRecordset rs to make sure everything else is working and it is.

any help is greatly appreciated
 


[tt]
430 Class doesn't support OLE Automation
430 Class doesn't support Automation (version 97)
[/tt]

Are you sure of the STATEMENT that is erroring? Hit the DEBUG button when you get the message.

Skip,
[sub]
[glasses] [red][/red]
[tongue][/sub]
 
yes i am sure, I have been reading it for the last two days ... and now i am seeing it in my sleep. (ha ha)

Code:
Run-Time Error '430'

Class does not support Automation or does not support expected interface.

Oh and i am running miscrosoft 2003 but its running at 2000 format. I tried the conversion to 2003 and either way same problem.

I hope this information helps
 



Please post the STATEMENT that is erroring.

Skip,
[sub]
[glasses] [red][/red]
[tongue][/sub]
 
Code:
xlApp.Workbooks(1).Worksheets(1).Range("A2").CopyFromRecordset rs
 
Have you tried to replace this:
Dim rs As Recordset
with this ?
Dim rs As DAO.Recordset

You may also try this:
xlApp.ActiveSheet.Range("A2").CopyFromRecordset rs

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886
 
hey there PHV, tried it before and made the changes again that you suggested. still the same error.

thanks again for your guys help
 


Try using the Watch Window on some of your objects.

rs
xlApp.Workbooks(1).Worksheets(1).Range("A2")
xlApp.Workbooks(1).Worksheets(1)
xlApp.Workbooks(1)
xlApp

and see if you get an error on any of these, that's where to focus.

Skip,
[sub]
[glasses] [red][/red]
[tongue][/sub]
 
well guys i want to thank you again. The only thing i could do is reinstall the OS and reinstall MS office. I tried uninstalling office and reinstalling it, but was unable to fix the problem.
After redoing the OS and Office I installed my VB.NET again. the error came back. Once I uninstalled the VB.NET everything worked fine. I guess this is another problem I’ll have to figure out. Again I do want to thank both you guys for all your advice.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top