VBA break up insert into tables so that I do not go over 1000

Question

This questions is follow up from here. What I need to do now is break up the insert into command in SQL so that I am do not exceed the limitations.

This is what I have so far:

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

Everything does what I expect but I need to somehow break up the INSERT INTO part so that I am not going over the 1000 insert limitations.

Any suggestions are greatly appreciated.

if you keep track of how many you currently have you can just execute your insert in the loop when you reach that number, reset the counter, and reset the query strings. Then (in case you have an exact multiple of your insert chunks) after the loop only execute an insert if that number is more than 0. You could also consider going not by number of records being inserted, but instead when your `Values` string exceeds a certain length (and then only insert after the loop if it's length is not 0). — Uueerdo, Mar 05 '20 at 18:22
@Uueerdo I am a completely new to VBA but I am trying to insert about 1600+ rows. If you know how to modify my code please provide an answer. — justanewb, Mar 05 '20 at 18:25
My VBA is **really** rusty, so a high level description is the best I should do. — Uueerdo, Mar 05 '20 at 18:28
@FaneDuru Could you write an answer with the code I provided and I can try to see if I can get it to work? — justanewb, Mar 05 '20 at 18:44
I would switch to a different approach more like this: https://stackoverflow.com/questions/44958471/excel-exporting-to-access-via-vba-is-causing-instability/44959630#44959630 It will be easier to manage. — Tim Williams, Mar 05 '20 at 18:49
You were speaking about 1600 + rows. `Range("H2:AS47")` is only an range example? — FaneDuru, Mar 05 '20 at 18:50
@FaneDuru - the input range is being "unpivoted" to create more records than rows in the input range. See the linked question — Tim Williams, Mar 05 '20 at 18:53
@Tim Williams: Thanks! I missed that link and completely missed all meaning... — FaneDuru, Mar 05 '20 at 19:01
As no one complains about not using [parameters](https://codereview.stackexchange.com/a/144119/175456), I do and read [bobby tables](https://bobby-tables.com)! — ComputerVersteher, Mar 07 '20 at 12:19

score 0 · Accepted Answer · edited Mar 07 '20 at 12:20

Keep a count of the records in the values string and execute the statement when the count reaches a limit. Reset the counter and clear the values string and repeat within the loop. Do one final execute if any values remain after exiting the loop.

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

@Computer I showed how to [here](https://stackoverflow.com/questions/60532135) but for some reason my advice was ignored. What did you do to get the syntax highlighting to work ? — CDP1802, Mar 07 '20 at 12:24
Do not get discouraged to mention that (little strokes fell big oaks.)! Even advice is ignored by OP, other readers will benefit! — ComputerVersteher, Mar 07 '20 at 12:29
Syntax highlighting was turned off by using`language-all: lang-none`see my edit in`side-by-side markdown`mode! But I prefer code fences as they are easier (no indention needed, less chars) e.g. `~~~vba LINEBREAK HERE Your Code LINEBREAK HERE ~~~` see https://stackoverflow.com/editing-help — ComputerVersteher, Mar 07 '20 at 12:34
@Computer Thanks, I turned it off because I couldn't get it to work properly ! — CDP1802, Mar 07 '20 at 12:40
Problem is that question has 2 tags with auto highlighting (sql, vba see tags description) what leads to default highlighting, But that is ugly for vba as it parses quotes(`'`) as comments, what leads to only partial highlighting and the colors are eye blinding too ;) — ComputerVersteher, Mar 07 '20 at 12:45

VBA break up insert into tables so that I do not go over 1000

1 Answers1