Run-time error 430: Class does not support Automation.....

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

My users are getting a run-time error 430 when my code copies a recordset
from access to excel. When I run my code on my computer I do not receive the
430 error.

I am running:
Access 2003
Excel 2003
XP
Professional
service pack 2

My users are running:
Access 97
Access 2003
Excel 2003
XP
Professional
service pack 2

The line (254) where the error occurs is:

..Range("A2").CopyFromRecordset rs3

I am not sure what is wrong, but I believe it has to do with the fact the
users are running two versions of Access. And I believe the problem my lay
with in my code because I do not specific say if the recordset is DAO or ADO.
Or it is in the way I handle the excel object. I am hoping some one has had
this problem and can tell me what I am missing or at lest tell me if I am on
the correct path. I thank anyone that can help me.

Copy of the code:
Private Sub Command0_Click()
On Error GoTo ErrorHandler
'Running Reports

Dim db As Database
Dim rs As Recordset
Dim rs1 As Recordset
Dim rs2 As Recordset
Dim rs3 As Recordset
Dim rs4 As Recordset
Dim qr As QueryDef
Dim xl As Excel.Application
Dim wbk As Excel.Workbook
Dim wks As Excel.Worksheet
Dim strPath As String
Dim strwbkName As String
Dim strFileName As String
Dim strwksName As String
Dim icount As Integer
Dim varItem As Variant
Dim strCriteria As String
Dim intPos As Integer
Dim strName As String
Dim intCurrentRow As Integer
Dim I As Integer
Dim j As Integer
Dim sheetExsit As Boolean

'Truning hourglass on and truning warnings off
DoCmd.Hourglass True
DoCmd.SetWarnings False

'Retrieving the report number from the form
For Each varItem In Me.lstBusLine.ItemsSelected
strCriteria = "" & Me.lstBusLine.ItemData(varItem) & "," & strCriteria
Next varItem

'Checking if they selected a report
If strCriteria = "" Then
MsgBox "Please select a business line first!", Buttons:=vbOK, Title:="My
Application"
GoTo ExitHandler
End If

'Find the current path of the database
strPath = Application.CurrentProject.Path

'Opening Database
Set db = CurrentDb

' Creating table 400 & 300
strName = ""

'Create the Excel object
If IsExcelRunning = True Then
Set xl = GetObject(, "Excel.Application")
Else
Set xl = CreateObject("excel.application")
End If

'Pulling the string apart
While (Len(strCriteria))
If intPos = InStr(strCriteria, ",") Then
If (intPos > 0) Then
strName = Trim(Left$(strCriteria, intPos - 1))

Me.txtStatus = "Creating specific tables...."
DoEvents

' creating the table for the specific busniess line
CreatTable strName

'Open queries for report
Set rs1 = db.OpenRecordset("SELECT IDDepartment, QueryName FROM
0tblQueryNames WHERE IDDepartment = " & strName & "")

' Find the name of the Bus line
Set rs2 = db.OpenRecordset("0tblDepartmentlReponsible",
dbOpenDynaset)
rs2.FindFirst "IDDepartment = " & rs1!IDDepartment

'setting the workbook name
strwbkName = rs2!Name & "-" & Format(Date,
"yyyymmdd") & ".xls"

'setting the file path for the workbook where it is
to be saved
strFileName = BrowseFolder("Selecet where you want "
& strwbkName & " saved!")

strFileName = strFileName & "\" & strwbkName

Me.txtStatus = "Creating excel workbook for " & rs2!Name
& "...."
DoEvents

'exporting queries
Do While Not rs1.EOF
Set rs4 = db.OpenRecordset(rs1!QueryName,
dbOpenDynaset)
If rs4.RecordCount > 0 Then
DoCmd.TransferSpreadsheet acExport,
acSpreadsheetTypeExcel9, rs1!QueryName, strFileName
End If
rs1.MoveNext
Loop
'Find a list of all the queries that were run to put on the
first tab of the excel workbook
Set rs3 = db.OpenRecordset("SELECT QueryName, Discription
FROM 0tblQueryNames WHERE IDDepartment = " & strName & "")

'Opeing workbook and add worksheet
Set wbk = xl.Workbooks.Open(strFileName)
Set wks = xl.Worksheets.Add(Count:=1, Type:=xlWorksheet)

'Formating excel workbook
With wks
.Name = "ERROR Description"
.Range("A2").CopyFromRecordset rs3 ' THIS IS
WHERE THE ERROR HAPPENS
.Cells(1, 1) = "SHEET NAME"
.Cells(1, 2) = "ERROR DESCRIPTION"

icount = 2
' Adding hyperlinks
Do While Not .Cells(icount, 1) = ""
'xl.Visible = True
strwksName = .Cells(icount, 1)
strwksName = Replace(strwksName, "-", "_")
I = xl.Sheets.Count
For j = 1 To I
If xl.Sheets(j).Name = strwksName Then
sheetExsit = True
Exit For
Else
sheetExsit = False
End If
Next
If sheetExsit = True Then
.Hyperlinks.Add .Cells(icount, 1), "",
SubAddress:="='" & strwksName & "'!A1"
Else
.Cells(icount, 3) = "No Errors Found"
End If
icount = icount + 1
Loop
.Cells.EntireColumn.AutoFit
End With

Me.txtStatus = "Saving excel workbook for " & rs2!Name &
"...."
DoEvents

' closing and saving workbook
wbk.Save
xl.Visible = True

'updating Status table
Set rs = db.OpenRecordset("SELECT
[0tblDepartmentlReponsible].IDDepartment, " & _
"
[0tblDepartmentlReponsible].LastRan FROM 0tblDepartmentlReponsible " & _
" WHERE
((([0tblDepartmentlReponsible].IDDepartment)=" & strName & "))")
With rs
.Edit
!LastRan = Date
.Update
End With

strCriteria = Right$(strCriteria, Len(strCriteria) - intPos)
intPos = 1
End If
Else
intPos = intPos + 1
End If

Wend

rs.Close
rs1.Close
rs2.Close
rs3.Close
rs4.Close

Me.lstBusLine.Requery

'unselecting
For intCurrentRow = 0 To Me.lstBusLine.ListCount - 1
Me.lstBusLine.Selected(intCurrentRow) = False 'unselecting all
Next intCurrentRow

MsgBox "DONE!", vbOKOnly

DoCmd.Hourglass False
DoCmd.SetWarnings True

ExitHandler:
Set wks = Nothing
Set wbk = Nothing
Set xl = Nothing
Me.txtStatus = "Ready...."
DoCmd.Hourglass False
DoCmd.SetWarnings True
Exit Sub

ErrorHandler:

If Err.Number = 1004 Then
MsgBox "This report has already been run today!"
wbk.Close (False)
GoTo ExitHandler
Else
Call ErrorHandler(Err.Number, Err.Description,
"cmdTicklerReport_Click", Me.Name, Erl())
Resume ExitHandler
Resume
End If

End Sub
 
My users are getting a run-time error 430 when my code copies a recordset
from access to excel. When I run my code on my computer I do not receive the
430 error.

I am running:
Access 2003
Excel 2003
XP
Professional
service pack 2

My users are running:
Access 97
Access 2003
Excel 2003
XP
Professional
service pack 2

The line (254) where the error occurs is:

.Range("A2").CopyFromRecordset rs3

I am not sure what is wrong, but I believe it has to do with the fact the
users are running two versions of Access. And I believe the problem my lay
with in my code because I do not specific say if the recordset is DAO or ADO.
Or it is in the way I handle the excel object. I am hoping some one has had
this problem and can tell me what I am missing or at lest tell me if I am on
the correct path. I thank anyone that can help me.

Copy of the code:
Private Sub Command0_Click()
On Error GoTo ErrorHandler
'Running Reports

Dim db As Database
Dim rs As Recordset
Dim rs1 As Recordset
Dim rs2 As Recordset
Dim rs3 As Recordset
Dim rs4 As Recordset
Dim qr As QueryDef
Dim xl As Excel.Application
Dim wbk As Excel.Workbook
Dim wks As Excel.Worksheet
Dim strPath As String
Dim strwbkName As String
Dim strFileName As String
Dim strwksName As String
Dim icount As Integer
Dim varItem As Variant
Dim strCriteria As String
Dim intPos As Integer
Dim strName As String
Dim intCurrentRow As Integer
Dim I As Integer
Dim j As Integer
Dim sheetExsit As Boolean

'Truning hourglass on and truning warnings off
DoCmd.Hourglass True
DoCmd.SetWarnings False

'Retrieving the report number from the form
For Each varItem In Me.lstBusLine.ItemsSelected
strCriteria = "" & Me.lstBusLine.ItemData(varItem) & "," & strCriteria
Next varItem

'Checking if they selected a report
If strCriteria = "" Then
MsgBox "Please select a business line first!", Buttons:=vbOK, Title:="My
Application"
GoTo ExitHandler
End If

'Find the current path of the database
strPath = Application.CurrentProject.Path

'Opening Database
Set db = CurrentDb

' Creating table 400 & 300
strName = ""

'Create the Excel object
If IsExcelRunning = True Then
Set xl = GetObject(, "Excel.Application")
Else
Set xl = CreateObject("excel.application")
End If

'Pulling the string apart
While (Len(strCriteria))
If intPos = InStr(strCriteria, ",") Then
If (intPos > 0) Then
strName = Trim(Left$(strCriteria, intPos - 1))

Me.txtStatus = "Creating specific tables...."
DoEvents

' creating the table for the specific busniess line
CreatTable strName

'Open queries for report
Set rs1 = db.OpenRecordset("SELECT IDDepartment, QueryName FROM
0tblQueryNames WHERE IDDepartment = " & strName & "")

' Find the name of the Bus line
Set rs2 = db.OpenRecordset("0tblDepartmentlReponsible",
dbOpenDynaset)
rs2.FindFirst "IDDepartment = " & rs1!IDDepartment

'setting the workbook name
strwbkName = rs2!Name & "-" & Format(Date,
"yyyymmdd") & ".xls"

'setting the file path for the workbook where it is
to be saved
strFileName = BrowseFolder("Selecet where you want "
& strwbkName & " saved!")

strFileName = strFileName & "\" & strwbkName

Me.txtStatus = "Creating excel workbook for " & rs2!Name
& "...."
DoEvents

'exporting queries
Do While Not rs1.EOF
Set rs4 = db.OpenRecordset(rs1!QueryName,
dbOpenDynaset)
If rs4.RecordCount > 0 Then
DoCmd.TransferSpreadsheet acExport,
acSpreadsheetTypeExcel9, rs1!QueryName, strFileName
End If
rs1.MoveNext
Loop
'Find a list of all the queries that were run to put on the
first tab of the excel workbook
Set rs3 = db.OpenRecordset("SELECT QueryName, Discription
FROM 0tblQueryNames WHERE IDDepartment = " & strName & "")

'Opeing workbook and add worksheet
Set wbk = xl.Workbooks.Open(strFileName)
Set wks = xl.Worksheets.Add(Count:=1, Type:=xlWorksheet)

'Formating excel workbook
With wks
.Name = "ERROR Description"
.Range("A2").CopyFromRecordset rs3 ' THIS IS
WHERE THE ERROR HAPPENS
.Cells(1, 1) = "SHEET NAME"
.Cells(1, 2) = "ERROR DESCRIPTION"

icount = 2
' Adding hyperlinks
Do While Not .Cells(icount, 1) = ""
'xl.Visible = True
strwksName = .Cells(icount, 1)
strwksName = Replace(strwksName, "-", "_")
I = xl.Sheets.Count
For j = 1 To I
If xl.Sheets(j).Name = strwksName Then
sheetExsit = True
Exit For
Else
sheetExsit = False
End If
Next
If sheetExsit = True Then
.Hyperlinks.Add .Cells(icount, 1), "",
SubAddress:="='" & strwksName & "'!A1"
Else
.Cells(icount, 3) = "No Errors Found"
End If
icount = icount + 1
Loop
.Cells.EntireColumn.AutoFit
End With

Me.txtStatus = "Saving excel workbook for " & rs2!Name &
"...."
DoEvents

' closing and saving workbook
wbk.Save
xl.Visible = True

'updating Status table
Set rs = db.OpenRecordset("SELECT
[0tblDepartmentlReponsible].IDDepartment, " & _
"
[0tblDepartmentlReponsible].LastRan FROM 0tblDepartmentlReponsible " & _
" WHERE
((([0tblDepartmentlReponsible].IDDepartment)=" & strName & "))")
With rs
.Edit
!LastRan = Date
.Update
End With

strCriteria = Right$(strCriteria, Len(strCriteria) - intPos)
intPos = 1
End If
Else
intPos = intPos + 1
End If

Wend

rs.Close
rs1.Close
rs2.Close
rs3.Close
rs4.Close

Me.lstBusLine.Requery

'unselecting
For intCurrentRow = 0 To Me.lstBusLine.ListCount - 1
Me.lstBusLine.Selected(intCurrentRow) = False 'unselecting all
Next intCurrentRow

MsgBox "DONE!", vbOKOnly

DoCmd.Hourglass False
DoCmd.SetWarnings True

ExitHandler:
Set wks = Nothing
Set wbk = Nothing
Set xl = Nothing
Me.txtStatus = "Ready...."
DoCmd.Hourglass False
DoCmd.SetWarnings True
Exit Sub

ErrorHandler:

If Err.Number = 1004 Then
MsgBox "This report has already been run today!"
wbk.Close (False)
GoTo ExitHandler
Else
Call ErrorHandler(Err.Number, Err.Description,
"cmdTicklerReport_Click", Me.Name, Erl())
Resume ExitHandler
Resume
End If

End Sub
Click to expand...

They may be using a different version of DAO or ADO... open one of
your code windows and select Tools, References from the menu. Make
sure that your users have the same version of DAO or ADO is checked.
Also make sure that the same version of office is checked.
 
They may be using a different version of DAO or ADO... open one of
your code windows and select Tools, References from the menu. Make
sure that your users have the same version of DAO or ADO is checked.
Also make sure that the same version of office is checked.
Click to expand...

Thank you Old Pro

I did check to make sure they had the correct References. And as far as I
can trust the users to read correctly…. they have the correct Reference and
the error still occurs. The users and I do not work in the same city, and I
don't have a PC to PC software at the moment on my computer to see what is
going on, on their computer.

Thank you again
 
Thank you Old Pro

I did check to make sure they had the correct References. And as far as I
can trust the users to read correctly.... they have the correct Reference and
the error still occurs. The users and I do not work in the same city, and I
don't have a PC to PC software at the moment on my computer to see what is
going on, on their computer.

Thank you again
Click to expand...

I'm not sure what the problem is... try using an earlier format like
acSpreadsheetTypeExcel5 instead and see if it makes a difference.
 
I'm not sure what the problem is... try using an earlier format like
acSpreadsheetTypeExcel5 instead and see if it makes a difference.
Click to expand...

That is good idea.. and a simple fix because I am already using
Transferspreadsheet method and it was working. It was the copy record set
that is failing. I will let you know if it works for my users.

thanks aging
 
Back
Top