从ADODBlogging集复制数据时，Excel表格丢失数字格式

我正在使用CopyFromRecordset方法从ADODBlogging集更新Excel表。

更新后，数字显示为有数字列的date。

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

有一个快速解决？ 任何帮助是极大的赞赏。

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

tblName – 引用一个现有的表，它保存与第一个数据相同格式/数据types的数据

Answer 1

以下是示例代码。 每当调用proT getTableData时，table1的格式化和列格式将根据logging集保留。 我希望这是你正在寻找的。

  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 

Answer 2

试试这个 – 将resultset复制到一个数组中，转换它，然后将其复制到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 

Answer 3

我知道这是一个迟到的答案，但我遇到了同样的错误。 我想我已经find了一个解决方法。

看来Excel预计的范围是左上angular的单元格，而不是一个单元格的范围。 所以只需修改您的语句到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 

还似乎要求目标工作表处于活动状态，因此可能必须确保工作表处于活动状态，然后再切换回先前处于活动状态的工作表。 这可能已被更高版本的Excel中修复。