复制超过100列时，excel vba copyfromrecordset变慢 [英] excel vba copyfromrecordset slows when copying over 100 columns
问题描述
我正在尝试使用下面的代码将数据从sql（2008 r2）表复制到excel 2003中的多个表 - 目前有c420000条记录，每周大约1000个扩展。这是要求，我没有选择使用访问或更高版本的excel作为输出。我一直在寻找一段时间，可以在不同的论坛上找到与同样或类似问题有关的许多线索，但没有什么特别的要求来满足我的要求或帮助我解决问题。
发生什么是代码将工作，但在大约30000行后显着减慢。我认为问题是超过100列的事实 - 我通过选择6或7列来测试代码，并在可接受的时间内返回一个完整的数据集。
代码在copyfromrecordset阶段减慢/挂起。如果我突破了代码，则给出错误（-2147467259;对象范围失败的方法CopyFromRecordset），但是代码实际上还没有失败，即可以继续，而不会出现重大问题。 >
我没有能够完成完整的记录集的代码，最长我已经让它运行（2小时）只完成了约50％ - 60％。
任何人都可以清楚地看出，我可以否定这个过程中的问题，因为它可以缓慢缓慢的磨合，或者建议我可能使用的另一种方法。任何帮助/建议感激之情 Sub DATA_Import（Frequency As String）
Dim sCon As String'连接属性的构建字符串
Dim sSQL As String'构建SQL属性的字符串
Dim rsData As ADODB.Recordset'引用到最新的ADO库 - 2.8
Dim cnxEWMS As ADODB.Connection'对最新的ADO库的引用 - 2.8
Dim lWScount As Long
Dim lRow As Long，lCol As Long'holder for last row& col in data
Dim c As Range'标识数据开始的位置 - 应该是常量，但你永远不会知道！
Dim Cx As Long'用于循环标记列以将空白更改为0
Dim wbNew As Workbook'最终目标文件！
Dim sFileDate As String'命名输出文件的日期
Dim wsNotes As Worksheet'产品说明书
Dim wsCover作为工作表的产品封面
工作表（标题）Cells.Delete
'使用Windows身份验证
'将无法正常工作，用户未在SQL服务器上列出
sCon =提供商= SQLOLEDB; &安培; _
数据源= SOMESERVER; &安培; _
初始目录= SomeDatabase; &安培; _
集成安全性= SSPI
'识别用于报告和构建SQL的频率
'每日数据仅为现场记录
如果频率=每日则
sSQL =SELECT *& _
FROM tblMainTabWithFlagsDaily& _
WHERE status ='LIVE';
Else
'weekly - 所有记录分割成多个表
sSQL =SELECT *& _
FROM tblMainTabWithFlagsDaily;
End If
'创建并打开与数据库的连接
设置cnxEWMS =新建ADODB.Connection
带cnxEWMS
.Provider =SQLOLEDB;
.ConnectionString = sCon
.Open
结束
'创建并打开记录集
设置rsData =新建ADODB.Recordset
rsData打开sSQL，cnxEWMS，adOpenForwardOnly，adLockReadOnly
应用程序
'如果从module1调用/测试构造
如果不是TestCaller然后
.ScreenUpdating = False
End If
.Calculation = xlCalculationManual
End with
如果不是rsData.EOF然后
'创建标题行'dummy'表
对于lCol = 0到rsData.Fields.Count - 1
带有工作表（标题）。范围（A1）
.Offset（0，lCol）.Value = rsData.Fields（lCol ）.Name
结束
下一个
设置c =工作表（标题）。行（1：1）。Cells.Find（warrflag_recno）
'将数据复制到工作簿中并相应格式
尽管不是rsData.EOF
如果wbNew Is Nothing然后
'创建新的产品工作簿
工作表（标题）。复制
设置wbNew = ActiveWorkbook
Else
lWScount = wbNew.Worksheets .Count
ThisWorkbook.Worksheets（Headings）。copy after：= wbNew.Worksheets（lWScount）
End If
带有wbNew.Worksheets（lWScount + 1）
.UsedRange.Font.Bold = True
如果Frequency =daily则
.Name =Live&格式（lWScount + 1，0＃）'不需要多张实时数据 - ave 15k - 16k记录
Else
.Name =Split&格式（lWScount + 1，0＃）
结束如果
'原因我们都在这里！
'从记录集复制55000条记录
'这个保持挂起，大概是因为列数
'减少列到6或7运行正常和快速
.Range（ A2）。CopyFromRecordset rsData，55000
'剩下的代码被删除
'，因为它只是格式化和创建笔记
'和封面，然后保存
'整理！
应用程序
.DisplayAlerts = True
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
结束
rsData.Close
设置rsData =没有
cnxEWMS.Close
设置cnxEWMS =没有
设置c =没有
设置wsNotes =没有
设置wsCover =没有
End Sub
你通常可以得到一个合理的速度与ADODB像这样：
''数据源z：\docs\test.accdb没有使用，它只是在那里得到一个
的工作字符串。
strCon =Provider = Microsoft.ACE.OLEDB.12.0; Data Source = z：\docs\test.accdb
cn.Open strCon
这将选择一个现有的工作簿与一个新的工作表名称，任何名称，
'不存在将工作。与SQL Server的ODBC连接是用于ODBC连接的任何
。
ssql =SELECT * INTO [Excel 8.0; HDR = YES; DATABASE = Z：\Docs\Test.xlsx]。[Sheet7]_
& FROM [ODBC; DRIVER = SQL Server Native Client 11.0; SERVER = localhost\SQLEXPRESS;_
& DATABASE = MyDB; Trusted_Connection = Yes;] MyTable
cn.Execute ssql
i'm trying to use the code below to copy data from a sql (2008 r2) table to multiple sheets in excel 2003 - there are currently c420000 records, expanding at around 1000 a week. this is the requirement, i have no option to use access or later versions of excel for the output. i have been searching for some time and can find many threads on different forums relating to the same or similar issues but nothing specific enough to meet my requirements or help me resolve the issue.
what happens is the code will work but slows noticeably after around 30000 rows. i think the issue is the fact there are over 100 columns - i tested the code by selecting 6 or 7 columns and it returns a full dataset as required within an acceptable time period.
the code slows/hangs at the copyfromrecordset stage. if i break out of the code an error (-2147467259; Method 'CopyFromRecordset' of object 'Range' failed) is given but the code hasn't actually failed (yet), ie it can be continued without major issues.
i have not been able to complete the code for the full recordset and the longest i have let it run (2 hours) only completed around 50% - 60%.
can anybody shed any light on how i might be able to negate the problem with the process as it stands grinding to a painfully slow pace or suggest another method i might use? any help/suggestions gratefully appreciated
Sub DATA_Import(Frequency As String)
Dim sCon As String ' building string for the connection property
Dim sSQL As String ' building string for the SQL property
Dim rsData As ADODB.Recordset ' reference made to latest ADO library - 2.8
Dim cnxEWMS As ADODB.Connection ' reference made to latest ADO library - 2.8
Dim lWScount As Long
Dim lRow As Long, lCol As Long ' holders for last row & col in data
Dim c As Range ' identifies where flags data begins - should be constant but you never know!
Dim Cx As Long ' for looping through the flags columns to change blanks to 0
Dim wbNew As Workbook ' the final destination file!
Dim sFileDate As String ' the date for naming the output file
Dim wsNotes As Worksheet ' notes sheets for product
Dim wsCover As Worksheet ' cover sheet for product
Worksheets("Headings").Cells.Delete
' using windows authentication
' won't work where user is not listed on SQL server
sCon = "Provider=SQLOLEDB;" & _
"Data Source=SOMESERVER;" & _
"Initial Catalog=SomeDatabase;" & _
"Integrated Security=SSPI"
' identify frequecy for reporting and build SQL
' daily data is live records only
If Frequency = "daily" Then
sSQL = "SELECT * " & _
"FROM tblMainTabWithFlagsDaily " & _
"WHERE status='LIVE';"
Else
'weekly - all records split over multiple sheets
sSQL = "SELECT *" & _
"FROM tblMainTabWithFlagsDaily;"
End If
' create and open the connection to the database
Set cnxEWMS = New ADODB.Connection
With cnxEWMS
.Provider = "SQLOLEDB;"
.ConnectionString = sCon
.Open
End With
' create and open the recordset
Set rsData = New ADODB.Recordset
rsData.Open sSQL, cnxEWMS, adOpenForwardOnly, adLockReadOnly
With Application
' if construct used for debugging/testing when called from module1
If Not TestCaller Then
.ScreenUpdating = False
End If
.Calculation = xlCalculationManual
End With
If Not rsData.EOF Then
' create header row 'dummy' sheet
For lCol = 0 To rsData.Fields.Count - 1
With Worksheets("Headings").Range("A1")
.Offset(0, lCol).Value = rsData.Fields(lCol).Name
End With
Next
Set c = Worksheets("Headings").Rows("1:1").Cells.Find("warrflag_recno")
' copy data into workbook and format accordingly
Do While Not rsData.EOF
If wbNew Is Nothing Then
' create the new "product" workbook
Worksheets("Headings").Copy
Set wbNew = ActiveWorkbook
Else
lWScount = wbNew.Worksheets.Count
ThisWorkbook.Worksheets("Headings").Copy after:=wbNew.Worksheets(lWScount)
End If
With wbNew.Worksheets(lWScount + 1)
.UsedRange.Font.Bold = True
If Frequency = "daily" Then
.Name = "Live" & Format(lWScount + 1, "0#") ' shouldn't need numerous sheets for live data - ave 15k - 16k records
Else
.Name = "Split" & Format(lWScount + 1, "0#")
End If
' THE REASON WE'RE ALL HERE!!!
' copy from recordset in batches of 55000 records
' this keeps hanging, presumably because of number of columns
' reducing columns to 6 or 7 runs fine and quickly
.Range("A2").CopyFromRecordset rsData, 55000
' the remainder of the code is removed
' as it is just formatting and creating notes
' and cover sheets and then saving
' tidy up!
With Application
.DisplayAlerts = True
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
rsData.Close
Set rsData = Nothing
cnxEWMS.Close
Set cnxEWMS = Nothing
Set c = Nothing
Set wsNotes = Nothing
Set wsCover = Nothing
End Sub
You can usually get quite a reasonable speed with ADODB like so:
''The data source z:\docs\test.accdb is not used, it is only there to get a
''working string.
strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=z:\docs\test.accdb"
cn.Open strCon
''This selects into an existing workbook with a new sheet name, any name that does
''not already exist will work. The ODBC connection to SQL Server is whatever you
''use for ODBC connection.
ssql = "SELECT * INTO [Excel 8.0;HDR=YES;DATABASE=Z:\Docs\Test.xlsx].[Sheet7] " _
& "FROM [ODBC;DRIVER=SQL Server Native Client 11.0;SERVER=localhost\SQLEXPRESS; " _
& "DATABASE=MyDB;Trusted_Connection=Yes;].MyTable"
cn.Execute ssql
这篇关于复制超过100列时，excel vba copyfromrecordset变慢的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
