Excel VBA - запись данных из SQL / Recordset очень медленная - PullRequest
Новая
       41

Excel VBA - запись данных из SQL / Recordset очень медленная

0 голосов
/ 23 марта 2020

Я пытаюсь записать SQL Данные сервера в лист Excel, но это очень медленно. Есть что оптимизировать? Примерно 4000 записей в 20 cColumns занимает 6-7 минут.

Модуль базы данных ("freigabe"): подключение к базе данных и получение RecordSet (это работает как чудо) 

Private Function ConnectSQL() As ADODB.Connection
    Set conn = New ADODB.Connection
        conn.ConnectionString = "DRIVER={SQL Server};" _
            & "SERVER=xxxxx;" _
            & " DATABASE=xxxxx;" _
            & "UID=xxxxxx;PWD=xxxxx; OPTION=3"

        conn.Open

    Set ConnectSQL = conn
End Function

Public Function load(Optional ByVal FieldName As String = "", Optional ByVal fieldValue As String = "", Optional ByVal ComparisonOperator As String = "=")
'wenn fehler return?
'-> Über errorhandler retun rs oder boolen
    Dim rs As New ADODB.Recordset
    Dim sql As String
    Dim contition As String

    contition = " "

    Dim sqlfrom As String
    Dim sqlto As String


On Error GoTo Fehler:


    sql = "SELECT * FROM " & TBLNAME & " WHERE storno='0' AND created BETWEEN '2020-02-01' AND '2020-02-15'"

    Set conn = ConnectSQL()
        rs.Open sql, conn, adOpenStatic
    Set load = rs

    Exit Function
    End If
Fehler:
    load = Err.Description
End Function

Получить / Запись: создание соединения и получение набора записей. While l oop занимает много времени. Я пропускаю текстовые столбцы (это происходит быстрее, но все еще слишком долго). Отображение окна загрузки, чтобы человек не думал, что Excel "не работает". После этого данные проверяются (не включены). 

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Dim rs As Recordset
    Dim k As Integer
    Dim i As Integer

    Dim startt As Double
    Dim endt As Double

    Dim rngDst As Range

    Set rs = freigabe.load()


    Set rngDst = Worksheets("Freigaben").Range("G2")

    With Worksheets("Freigaben").Range("g2:Z50000")
        .ClearContents
        '.CopyFromRecordset rs
    End With
    Count = rs.RecordCount
    k = 0


    gui_laden.Show

    startt = Timer
    With rs
        If Not .BOF And Not .EOF Then
            .MoveLast
            .MoveFirst
            While Not .EOF
                For i = 0 To .Fields.Count - 1
                    If i <> 13 And i <> 2 And i <> 10 And i <> 5 And i <> 6 And i <> 0 Then  rngDst.Offset(, i) = .Fields(i).Value 'skip unneccessary data and write
                Next i
                k = k + 1
                Debug.Print k & "/" & Count
                gui_laden.lbl_status = "Lade Daten herunter: " & k & "/" & Count
                gui_laden.Repaint
                .MoveNext
                DoEvents 'Ensure Application doesn't freeze
                Set rngDst = rngDst.Offset(1)
            Wend
        End If
    End With

    endt = Timer - startt
    Debug.Print "Dauer: " & endt

Что я пробовал:

  1. CopyFromRecordSet -> Приложение зависает
  2. Тест в новом рабочая тетрадь -> та же

Большое спасибо!

...