VBA разбить вставку в таблицы, чтобы я не go более 1000

Question

Этот вопрос является продолжением здесь . Теперь мне нужно разбить команду вставки в команду в SQL, чтобы я не превышал ограничения.

Это то, что я имею до сих пор:

Sub second_export()
Dim sSQL As String, sCnn As String, sServer As String
    Dim db As Object, rs As Object
    sServer = "CATHCART"
    sCnn = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=True;Initial Catalog=Portfolio_Analytics;Data Source=" & sServer & ";" & _
              "Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;"

    Set db = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")
    If db.State = 0 Then db.Open sCnn

    Dim rw As Range, n As Long
    Dim GLID, category, dt, amount
    PropertyName = ActiveSheet.Range("F2").Value
    InsertedDate = ActiveSheet.Range("G2").Value
    StrSQL = "INSERT INTO SBC_Performance_Metrics VALUES"
    Values = ""
    For Each rw In ActiveSheet.Range("H2:AS47").Rows
        'fixed per-row
        GLID = Trim(rw.Cells(1).Value)
        category = Trim(rw.Cells(2).Value)

        'loopover the date columns
        For n = 3 To rw.Cells.Count

            dt = rw.Cells(n).EntireColumn.Cells(1).Value 'date from Row 1
            amount = rw.Cells(n).Value
            'Debug.Print PropertyName, GLID, category, amount, dt
            Values = Values & "('" & GLID & "', " & "'" & PropertyName & "', " & "'" & category & "', " & amount & ", " & "'" & dt & "', " & "'" & InsertedDate & "'),"
            'Debug.Print Values
        Next n
    Next rw

    StrSQL = StrSQL & Values
    StrSQL = Left(StrSQL, Len(StrSQL) - 2)
    StrSQL = StrSQL & ");"
    Debug.Print StrSQL
    'Set rs = db.Execute(StrSQL)
End Sub

Все делает то, что я ожидаю, но мне нужно как-то разбить часть INSERT INTO, чтобы не превышать ограничения на вставку 1000.

Любые предложения приветствуются.

Answer 1

Сохраните количество записей в строке значений и выполните инструкцию, когда количество достигнет предела. Сбросьте счетчик и очистите строку значений и повторите в пределах l oop. Выполните одно окончательное выполнение, если после выхода из l oop.

Sub second_export()

    ' sheet layout
    Const DATA_RANGE = "H2:AS47"
    Const PROPERTY_NAME = "F2"
    Const INSERTED_DATE = "G2"

    ' database
    Const SERVER = "CATHCART"
    Const TABLE_NAME = "SBC_Performance_Metrics"
    Const BATCH_SIZE = 500 ' insert every 500 rows

    ' db connection
    Dim sCnn As String, db As Object, rs As Object
    sCnn = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=True;" & _
           "Initial Catalog=Portfolio_Analytics;Data Source=" & SERVER & ";" & _
           "Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;"

    Set db = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")

    If db.State = 0 Then db.Open sCnn

    ' take dates from row above DATA_RANGE
    Dim dates As Range
    Set dates = ActiveSheet.Range(DATA_RANGE).Rows(1).Offset(-1, 0)
    Debug.Print dates.Address

    Dim PropertyName As String, InsertedDate As Date, GL As String, Category As String
    Dim rowcount As Integer, dataRow As Range, col As Integer, count As Integer
    Dim GLID As String, dt As Date, amount ''As Currency perhaps ??

    Dim SQL As String, sqlValues As String
    SQL = "INSERT INTO " & TABLE_NAME & " VALUES "
    sqlValues = ""

    ' load data
    PropertyName = ActiveSheet.Range(PROPERTY_NAME).Value
    InsertedDate = ActiveSheet.Range(INSERTED_DATE).Value

    For Each dataRow In ActiveSheet.Range(DATA_RANGE).Rows

        ' fixed per-row
        GLID = Trim(dataRow.Cells(1).Value)
        Category = Trim(dataRow.Cells(2).Value)

        ' loopover the date columns
        For col = 3 To dataRow.Cells.count

            dt = dates.Cells(1, col).Value 'date from header
            amount = dataRow.Cells(col).Value
            'Debug.Print GLID, PropertyName, Category, amount, dt

            sqlValues = sqlValues & "('" & GLID & "', " & "'" & PropertyName &  _
                                    "', " & "'" & Category & "', " & amount & ", " & _ 
                                    "'" & dt & "', " & "'" & InsertedDate & "'),"

            count = count + 1
            ' insert batch of records when necessary
            If count >= BATCH_SIZE Then
                ' remove end comma and execute
                sqlValues = Left(sqlValues, Len(sqlValues) - 1)
                db.Execute SQL & sqlValues
                MsgBox count & " inserted"

                ' reset for next batch
                sqlValues = ""
                count = 0
            End If
        Next col
    Next dataRow

    ' insert remaining
    If Len(sqlValues) > 0 Then
        sqlValues = Left(sqlValues, Len(sqlValues) - 1)
        db.Execute SQL & sqlValues
        MsgBox count & " inserted"
    End If

    ' result
    Set rs = db.Execute("SELECT COUNT(*) FROM " & TABLE_NAME)
    MsgBox rs(0) & " records in table " & TABLE_NAME, vbInformation

    db.Close
    Set db = Nothing

End Sub

остаются какие-либо значения.