Copy From RecordSet Fails

[jason_kelly]

Hi There,
I need your help with fixing the following code below.
Whenever I go to export my Data to Excel it seems to work fine, however,
When there is a larger Recordset (205 records total), it fails with error message:
------------------------------------------------------
Run-time error '-2147467259 (800040005)':
Method 'CopyFromRecordset' of object 'Range' failed.
------------------------------------------------------
I am stuck and don't know how to rid this error.
Any help is greatly appreciated.
Much thanks and appreciation
Cheers,
Jay

'-------------------------------------------------------
Public Sub ExportTOExcel()
'-------------------------------------------------------
Dim oApp As Object
Dim oWB As Object
Dim maxRows
Dim curRecs
Dim FullFileName
Dim tempdate
Set oApp = CreateObject("Excel.Application")
oApp.Visible = False
Set oWB = oApp.Workbooks.Add
temp_date = Format(Date, "dd/mm/yyyy") & " " & Format(Now, "h:mm AMPM")
   
  If Val(oApp.Version) < 12 Then
FullFileName = Application.GetSaveAsFilename("Export.xls", _
    "Excel file (*.xls),*.xls", 1, frmSplash.IMTS_Caption & " - Export to")
    maxRows = 65000
  Else
FullFileName = Application.GetSaveAsFilename("Export.xlsx", _
    "Excel file (*.xlsx),*.xlsx", 1, frmSplash.IMTS_Caption & " - Export to")
    maxRows = 1048576
  End If
    If FullFileName <> False Then
  If recCount > maxRows Then
    loops = recCount / maxRows
  Else
    loops = 1
  End If
  
  curRecs = maxRows
  
  ' Get the Headers
  ReDim hdrs(rs.Fields.Count)
  x = 0
  For Each fld In rs.Fields
    hdrs(x) = fld.Name
    x = x + 1
  Next fld
  
    oApp.ActiveSheet.Cells.EntireRow.RowHeight = 11
    oApp.ActiveSheet.Cells.EntireRow.Font.Name = tahoma
    oApp.ActiveSheet.Cells.EntireRow.Font.Size = 8
    
    
    oWB.Sheets(1).Cells(1, 1) = "IMTS Report"
    oWB.Sheets(1).Cells(1, 1).Font.Bold = True
    oWB.Sheets(1).Range("A1:Q1").Merge
    oWB.Sheets(1).Range("A1:Q1").HorizontalAlignment = xlCenter
    
    oWB.Sheets(1).Cells(2, 1) = "Date: " & temp_date
    oWB.Sheets(1).Range("A2:C2").Merge
    oWB.Sheets(1).Range("A2:C2").HorizontalAlignment = xlLeft
    oWB.Sheets(1).Range("A4:Q4").Interior.ColorIndex = 15
      For i = 0 To rs.Fields.Count - 1
        oWB.Sheets(1).Cells(4, i + 1).Value = rs.Fields(i).Name
    Next
    
  For i = 1 To loops
    
    oWB.Sheets(1).Range("4:3").Font.Bold = True
    oWB.Sheets(1).Cells(5, 1).CopyFromRecordset rs, maxRows
        
        curRecs = curRecs + maxRows
    If i <> loops Then
      Set oWB = oWB.Worksheets.Add
      oWB.Name = shtName & i + 1
    End If
  Next i
  
    oWB.SaveAs (FullFileName)
    oWB.Close
    Set oWB = Nothing
    oApp.Quit
    Set oApp = Nothing
    Else
    Exit Sub
    
End If
End Sub

 

[Norie]

jason

Have you tried without all the formatting?

That could be causing problems, especially the merged cells.

Why not just do the formatting once the data is nice and safe in Excel?

 

[jason_kelly]

Hi Norie,

I have tried and removed all the formatting, in this case, the end result was still the same. I was researching on Google about the Character limitation and something about OLE objects but I really have no idea what I am doing, and this problem I am having is really beyond me. =\

Jay.

 

[Norie]

Jay

Sorry, should have asked about the data - the merged cells just seemed to stick out.

Do any of the fields in the data contain objects like pictures, or even documents?

Does the database the data is coming from even support a field of that type?

 

[Richard Schollar]

What kind of a recordset is it and what version of Excel and Access are you using (I'm assuming this is Access coding)?

 

[jason_kelly]

Hi Norie,

Just to get back to you and answer your questions,

The database does not contain an OLE objects, but im suspecting the culprit is the character limit. Is there even a way to bypass with the code previously provided.

Cheers,

Jay

 

[jason_kelly]

Hi Richard,

My appologies, I should have specified the specifics, thanks for bringing this up.

The Recordset is an ADO Recordset, with Excel 2003 and Access 2003 (mdb database).

Set rs = CreateObject("ADODB.Recordset")
cn.Open "DBQ=" & dbPath & ";Driver={Microsoft Access Driver (*.mdb)};"

 

[Norie]

Jason

So is there a Memo field or similar in the data?

Is the recordset based on a query?

 

[jason_kelly]

Hi Norie,

I am not quite sure what you mean by "So is there a Memo field or similar in the data?"

To answer your second question, yes the RecordSet is based on a Query.

Cheers,

Jay

 

[Richard Schollar]

Norie is asking what are the datatypes of the fields (returned in the query) ie if you open the table in Access that holds them in Design View, what does it say the Field Sizes are? Is one of them a Memo type?