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

复制超过100列时，excel vba copyfromrecordset会变慢

1 个答案: