excel vba copyfromrecordset當複製超過100列時變慢

Question

我試圖使用下面的代碼將數據從sql（2008 r2）表複製到excel 2003中的多張工作表 - 目前有c420000記錄，擴展時間大約爲1000周。這是要求，我沒有選擇使用訪問或更高版本的Excel輸出。我一直在尋找一些時間，可以在不同的論壇上找到許多關於相同或類似問題的主題，但沒有足夠的具體內容來滿足我的要求或幫助我解決問題。

會發生什麼事情是代碼將工作，但大約30000行後顯着減慢。我認爲問題是有超過100列的事實 - 我通過選擇6或7列來測試代碼，並在可接受的時間段內根據需要返回完整的數據集。

代碼在copyfromrecordset階段放慢/掛起。如果我打破了代碼錯誤（-2147467259;對象'Range'的方法'CopyFromRecordset'失敗），但代碼實際上並未失敗（還），即它可以繼續而沒有重大問題。

我還沒有能夠完成整個記錄集的代碼和最長的我讓它運行（2小時）只完成了大約50％ - 60％。

任何人都可以闡明我如何能夠否定這個過程中的問題，因爲它站在一個痛苦的緩慢步伐，或建議我可能使用的另一種方法？任何幫助/建議，衷心感謝

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 

Answer 1

您通常可以得到相當合理的速度ADODB像這樣：

''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