从ADODB记录集复制数据时,Excel表丢失数字格式

Question

我正在使用该方法从ADODB记录集更新excel表CopyFromRecordset.

更新后,数字显示为有数字列的日期.

到目前为止我使用的解决方法是通过VBA将列格式化为数字,但这不是一个好的解决方案,因为报告需要更长的时间才能完成.另外,我必须编写代码来容纳很多表.

有快速解决方案吗？任何帮助是极大的赞赏.

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

tblName - 指的是保存与第一个数据具有相同格式/数据类型的数据的现有表

Answer 1

下面是示例代码。每当调用 proc getTableData 时，table1 的格式和列格式将根据记录集保留。我希望这就是您正在寻找的。

 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