CopyFromRecordset Error

[Guest]

Hi all,

I'm using CopyFromRecordset to copy the values of a recordset into an excel
worksheet. Everything works fine except one small issue.

When I run the code, I get error code as follows:
Err.Number: -2147417851
Err.Description: Method 'CopyFromRecordset' of object 'Range' failed

Now, if the program stops and then I restart it without editing any code,
the rest of the code runs perfectly. And I tried catching the error and if I
restart the code exactly after the code breaks, everything runs normally
again.

The code causing the error is:
xlWshtData.Range("A2").CopyFromRecordset rstData

Now, I used A2 based on an example in the Help. It stated that the
recordset would be copied into the worksheet from that point in the worksheet.

Anyone have any ideas what the problem is or how to solve it? Any help is
appreciated.

Thanks,
Jay

 

[Van T. Dinh]

It may be a timing problem, e.g. the Recordset has not been fully populated
when the CopyFromRecordset is executed.

Try adding 2 or 3 statements DoEvents before the the CopyFromRecordset
statement and see if it helps.

Alternatively if you use ADO Recordset, use the FetchComplete Event of the
Recordset to execute the CopyFromRecordset statement.

 

[Guest]

Thanks for the reply Van. Unfortunately, none of that worked.

I narrowed down the problem. It only occurred if I was trying to place the
data onto an existing worksheet. If I used CopyFromRecordset into a new
worksheet, it worked perfectly.

I still don't know what the cause of the error was, but I've found a
workaround.

I switched my DAO recordsets to ADO and used the following example:
<a
href="http://support.microsoft.com/default.aspx?scid=kb;en-us;246335#XSLTH3133121122120121120120">http://support.microsoft.com/default.aspx?scid=kb;en-us;246335#XSLTH3133121122120121120120</a>

I removed all using CopyFromRecordset and just used the code applicable to
Excel 97 or earlier. I'm using Excel 2003, but the code works just as well
and caused no errors.

Thanks,
Jay

 

[Van T. Dinh]

Strange. I used DAO Recordsets without any problem.

Here the actual code in one of my databases:

=============================
Public Sub CreateFFExcel()
'================
' vbaFormulation.CreateFFExcel
'--------
' Purpose:
'--------
' Notes :
'--------
' Parameters:
'--------
' Called Subs/Functions
' (none)
'--------
' Calling Subs/Functions
' (none)
'--------
' Returns:
' (none)
'--------
' Author : Van T. Dinh, 15/Dec/2004
'--------
' Revision History
' 15/Dec/2004 (VTD): First-coded
'================

Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim rst As DAO.Recordset

Dim xlApp As Excel.Application
Dim xlWBook As Excel.Workbook
Dim xlWSheet As Excel.Worksheet

Dim intFieldCount As Integer
Dim intColumn As Integer

On Error GoTo CreateFFExcel_Err
' Create an instance of Excel and add a workbook
Set xlApp = CreateObject("Excel.Application")
Set xlWBook = xlApp.Workbooks.Add("\\NSWCITRIX\CTX_A-BOM$\FactForm.xlt")

Set db = DBEngine(0)(0)

' FactForm Lookup
Set xlWSheet = xlWBook.Worksheets("FFLookup")
Set qdf = db.QueryDefs("qselForXLS_FactForm_LookUp")
Set rst = qdf.OpenRecordset(dbOpenSnapshot)

' Copy rows (Fact Formulation details)
xlWSheet.Cells(2, 1).CopyFromRecordset rst
rst.Close

Set qdf = db.QueryDefs("qselForXLS_FactFormDetails_Crosstab")

' Brisbane
Set xlWSheet = xlWBook.Worksheets("Brisbane")
qdf.Parameters("ParamFactoryID") = 2
Set rst = qdf.OpenRecordset(dbOpenSnapshot)
Call FillFactorySheet(xlWSheet, rst)
rst.Close

' Perth
Set xlWSheet = xlWBook.Worksheets("Perth")
qdf.Parameters("ParamFactoryID") = 4
Set rst = qdf.OpenRecordset(dbOpenSnapshot)
Call FillFactorySheet(xlWSheet, rst)
rst.Close

' Smithfield
Set xlWSheet = xlWBook.Worksheets("Smithfield")
qdf.Parameters("ParamFactoryID") = 1
Set rst = qdf.OpenRecordset(dbOpenSnapshot)
Call FillFactorySheet(xlWSheet, rst)
rst.Close

' Sunshine
Set xlWSheet = xlWBook.Worksheets("Sunshine")
qdf.Parameters("ParamFactoryID") = 3
Set rst = qdf.OpenRecordset(dbOpenSnapshot)
Call FillFactorySheet(xlWSheet, rst)
rst.Close

' BaseForm Lookup
Set xlWSheet = xlWBook.Worksheets("BFLookup")
Set qdf = db.QueryDefs("qselForXLS_BaseForm_LookUp")
Set rst = qdf.OpenRecordset(dbOpenSnapshot)

' Copy rows (Fact Formulation details)
xlWSheet.Cells(2, 1).CopyFromRecordset rst
rst.Close

Set qdf = db.QueryDefs("qselForXLS_BaseFormDetails_Crosstab")

' Base Formulation sheet
Set xlWSheet = xlWBook.Worksheets("BaseFormulation")
Set rst = qdf.OpenRecordset(dbOpenSnapshot)
Call FillFactorySheet(xlWSheet, rst)
rst.Close


' Display Excel and give user control of Excel's lifetime
xlApp.Visible = True
xlApp.UserControl = True

CreateFFExcel_Exit:
Set rst = Nothing
Set db = Nothing
Set xlWSheet = Nothing
Set xlWBook = Nothing
Set xlApp = Nothing
Exit Sub

CreateFFExcel_Err:
Select Case Err.Number
Case 0
Case Else
MsgBox "Error " & Err.Number & ": " & Err.Description & vbCrLf &
vbCrLf & _
"(Programmer's note: vbaFormulation.CreateFFExcel)" & vbCrLf, _
vbOKOnly + vbCritical, "Run-time Error!"
End Select
Resume CreateFFExcel_Exit
End Sub
===========================

Public Sub FillFactorySheet(WSheet As Excel.Worksheet, _
rst As DAO.Recordset)
'================
' vbaFormulation.FillFactorySheet
'--------
' Purpose:
'--------
' Notes :
'--------
' Parameters:
'--------
' Called Subs/Functions
' (none)
'--------
' Calling Subs/Functions
' (none)
'--------
' Returns:
' (none)
'--------
' Author : Van T. Dinh, 08/Dec/2004
'--------
' Revision History
' 08/Dec/2004 (VTD): First-coded
'================

Dim intFieldCount As Integer
Dim intColumn As Integer

On Error GoTo FillFactorySheet_Err
' Copy FactFormCodes to the 8th row of the worksheet
intFieldCount = rst.Fields.Count
For intColumn = 6 To intFieldCount
WSheet.Cells(8, intColumn).Value = rst.Fields(intColumn - 1).Name
Next

' Copy rows (RawMat details and PHRs
WSheet.Cells(9, 1).CopyFromRecordset rst
DoEvents

FillFactorySheet_Exit:
Exit Sub

FillFactorySheet_Err:
Select Case Err.Number
Case 0
Case Else
MsgBox "Error " & Err.Number & ": " & Err.Description & vbCrLf &
vbCrLf & _
"(Programmer's note: vbaFormulation.FillFactorySheet)" & vbCrLf, _
vbOKOnly + vbCritical, "Run-time Error!"
End Select
Resume FillFactorySheet_Exit
End Sub
=========================================

At least you found the work-around.