asked on

Transferring Data from Access to Excel in VBA...Receiving error 430 - class does not support automation

Hi, one of my user's is getting an error - my program copies data from a recordset in Access to Excel using BA code and I receive an error #430 class does not support automation. I don't have this problem and no other users have reported this issue - I think it may just be this individuals pc. Any thoughts?

See code snippet attached

Thanks,
Marilyn

Private Sub cmdApproval_Click()
Dim xlApp As Excel.Application
Dim xlwb As Excel.Workbook
Dim xlws As Excel.Worksheet
Dim xlrng As Excel.Range
Dim DB As DAO.Database
Dim strSQL As String
Dim strRecipient As String
Dim strBodyText As String
Dim rstQuote As DAO.Recordset
Dim vaTmp() As String
Dim vaNew As Variant
Dim strExportFile As String
Dim strVersion As String
 
On Error GoTo cmdApproval_Err
DoCmd.Save
Set DB = CurrentDb()
DoCmd.SetWarnings False
 
Me.Contract_Admin.SetFocus
Me.tabOpportunity.SetFocus
 
'MsgBox ("This quote is to be emailed to only your Manager for approval purposes.")
Set xlApp = New Excel.Application
Set xlwb = xlApp.Workbooks.Open("C:\Quote Templates\Application Files\Quote Template Export.xls")
'xlApp.Visible = "True"
 
'Delete out all data on Equipment Worksheet in template and copy in new data
strSQL = "Select * from tbl_Quote_Equipment where QuoteNo = '" & Me.txtQuoteNo & "';"
Set rstQuote = DB.OpenRecordset(strSQL, dbOpenDynaset)
   
Set xlws = xlwb.Sheets("Equipment")
xlws.Rows("2:65536").ClearContents
Set xlrng = xlws.Range("A2")
xlrng.CopyFromRecordset rstQuote

Open in new window

ASKER CERTIFIED SOLUTION

Patrick Matthews

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Patrick Matthews

You could also have this person remove the reference to Excel, and modify the code to:

Private Sub cmdApproval_Click()
Dim xlApp As Object 'Excel.Application
Dim xlwb As Object 'Excel.Workbook
Dim xlws As Object 'Excel.Worksheet
Dim xlrng As Object 'Excel.Range
Dim DB As DAO.Database
Dim strSQL As String
Dim strRecipient As String
Dim strBodyText As String
Dim rstQuote As DAO.Recordset
Dim vaTmp() As String
Dim vaNew As Variant
Dim strExportFile As String
Dim strVersion As String

On Error GoTo cmdApproval_Err
DoCmd.Save
Set DB = CurrentDb()
DoCmd.SetWarnings False

Me.Contract_Admin.SetFocus
Me.tabOpportunity.SetFocus

'MsgBox ("This quote is to be emailed to only your Manager for approval purposes.")
Set xlApp = CreateObject("Excel.Application")
Set xlwb = xlApp.Workbooks.Open("C:\Quote Templates\Application Files\Quote Template Export.xls")
'xlApp.Visible = "True"

'Delete out all data on Equipment Worksheet in template and copy in new data
strSQL = "Select * from tbl_Quote_Equipment where QuoteNo = '" & Me.txtQuoteNo & "';"
Set rstQuote = DB.OpenRecordset(strSQL, dbOpenDynaset)

Set xlws = xlwb.Sheets("Equipment")
xlws.Rows("2:65536").ClearContents
Set xlrng = xlws.Range("A2")
xlrng.CopyFromRecordset rstQuote