FIX: CopyFromRecordset Fails with OLE Automation

RESOLUTION

Microsoft provides examples of Visual Basic for Applications procedures for illustration only, without warranty either expressed or implied, including, but not limited to the implied warranties of merchantability and/or fitness for a particular purpose. The Visual Basic procedures in this article are provided 'as is' and Microsoft does not guarantee that they can be used in all situations. While Microsoft Product Support professionals can help explain the functionality of a particular macro, they will not modify these examples to provide added functionality, nor will they help you construct macros to meet your specific needs. If you have limited programming experience, you may want to consult one of the Microsoft Solution Providers. Solution Providers offer a wide range of fee-based services, including creating custom macros. For more information about Microsoft Solution Providers, call Microsoft Customer Information Service at (800) 426-9400.

To workaround this problem, transfer the data into an array, and then replace any Null fields with "Empty." Once the data in the recordset has been transferred to the array, dump the contents of the array onto the worksheet.

The Microsoft Access code below demonstrates this method:

   Public Function Test()

   Dim xl As Object
   Dim db As Database
   Dim rs As Recordset
   Dim r As Integer, c As Integer
   Dim TempArray() As Variant

       'Create a new object for Microsoft Excel.
       Set xl = CreateObject("excel.application.5")

       'Set the database object and create the recordset for the Customer
       'table in the directory
       'c:\program files\common files\microsoft shared\msquery.
       Set db = OpenDatabase("C:\Program Files\Common Files\" & _
           "Microsoft Shared\Msquery", False, False, "dbase IV;")
       Set rs = db.OpenRecordset("Customer")

       'Start a new workbook.
       xl.workbooks.Add

       'Create an array where # rows = # records and # columns = # fields
       'in the recordset.
       ReDim TempArray(1 To rs.RecordCount, 1 To rs.Fields.Count)

       'Place the contents of the recordset into the array TempArray
       'and replace any nulls in the recordset with "Empty."
       For r = 1 To rs.RecordCount
           For c = 1 To rs.Fields.Count
               If IsNull(rs(c - 1)) Then
                   TempArray(r, c) = Empty
               Else
                   TempArray(r, c) = rs(c - 1)
               End If
           Next
           rs.MoveNext
       Next

       'Dump the contents of TempArray onto the active worksheet.
       xl.activesheet.range("a1").Resize(rs.RecordCount, _
           rs.Fields.Count).Value = TempArray

       Set xl = Nothing

   End Function