Excel table loses number formats when data is copied from ADODB recordset

问题

I'm updating an excel table from an ADODB recordset using the CopyFromRecordset method.

After the update, the numbers show up as dates wherever there are number columns.

The workaround I used until now is to format the columns back to numbers through VBA, but it's not a good solution as takes more time for the report to complete. Also I have to write code to accommodate a lot of tables.

Is there a quick fix? Any help is greatly appreciated.

'Delete old data and copy the recordset to the table
Me.ListObjects(tblName).DataBodyRange.ClearContents
Me.Range(tblName).CopyFromRecordset rst

tblName - refers to an existing table that held data of the same format/datatype as rst data

回答1:

Try this - this copies resultset into a array, transposes it and then copies it into excel

Dim rs As New ADODB.Recordset

Dim targetRange As Excel.Range

Dim vDat As Variant

' Set rs

' Set targetRange   

rs.MoveFirst

vDat = Transpose(rs.GetRows)

targetRange.Value = vDat


Function Transpose(v As Variant) As Variant
    Dim X As Long, Y As Long
    Dim tempArray As Variant

    ReDim tempArray(LBound(v, 2) To UBound(v, 2), LBound(v, 1) To UBound(v, 1))
    For X = LBound(v, 2) To UBound(v, 2)
        For Y = LBound(v, 1) To UBound(v, 1)
            tempArray(X, Y) = v(Y, X)
        Next Y
    Next X

    Transpose = tempArray

End Function

回答2:

I know this is a late answer, but I was encountering this same error. I think I've found a workaround.

It seems Excel expects the range to be the top-left cell rather than a range of cells. So just modify your statement to Range(tblName).Cells(1,1).CopyFromRecordset rst

'Delete old data and copy the recordset to the table
Me.ListObjects(tblName).DataBodyRange.ClearContents
Me.Range(tblName).Cells(1,1).CopyFromRecordset rst

There also seems to be a requirement that the target sheet be active, so you might have to ensure the sheet is active first, and then change back to the previously active sheet. This might have been fixed in later version of Excel.

回答3:

Below is sample code. Whenever the proc getTableData is called the formatting & column format of the table1 will be retained according to the recordset. I hope this is what you are looking for.

 Sub getTableData()

    Dim rs As ADODB.Recordset
    Set rs = getRecordset

    Range("A1").CurrentRegion.Clear
    Range("A1").CopyFromRecordset rs
    Sheets("Sheet1").ListObjects.Add(xlSrcRange, Range("A1").CurrentRegion, , xlNo).Name = "Table1"

End Sub



Function getRecordset() As ADODB.Recordset

    Dim rsContacts As ADODB.Recordset
    Set rsContacts = New ADODB.Recordset

    With rsContacts
        .Fields.Append "P_Name", adVarChar, 50
        .Fields.Append "ContactID", adInteger
        .Fields.Append "Sales", adDouble
        .Fields.Append "DOB", adDate
        .CursorLocation = adUseClient
        .CursorType = adOpenStatic

        .Open

        For i = 1 To WorksheetFunction.RandBetween(3, 5)
             .AddNew
            !P_Name = "Santosh"
            !ContactID = 2123456 * i
            !Sales = 10000000 * i
            !DOB = #4/1/2013#
            .Update
        Next

        rsContacts.MoveFirst
    End With

    Set getRecordset = rsContacts
End Function

回答4:

After reading through forums posts of other people who encountered the same problem, here are all the options I know of (some of them already mentioned in other answers):

1. Insert only into the first cell of the target range - see @ThunderFrame's answer.
2. Activate worksheet that contains target range on the line above CopyFromRecordset()

3. Turn off automatic recalculation:

   Application.Calculation = xlCalculationManual
   .CopyFromRecordset rs
   Application.Calculation = xlCalculationAutomatic
   

Workarounds:

1. Iterate rows/columns and insert values one at a time - @Sriketan's answer provides code for this one. Another code snippets are in the links below.
2. Paste into temporary workbook and then copy it from there.

Sources:

1. Duchgemini's post and discussion: https://dutchgemini.wordpress.com/2011/04/21/two-serious-flaws-with-excels-copyfromrecordset-method/
2. Microsoft's forum: https://social.msdn.microsoft.com/Forums/office/en-US/129c0a52-4ccb-4f54-9e38-8c0ae6e300b1/copyfromrecordset-corrupts-cell-formats-for-the-whole-excel-workbook?forum=exceldev

来源：https://stackoverflow.com/questions/16070313/excel-table-loses-number-formats-when-data-is-copied-from-adodb-recordset