VBA分解插入表格，这样我就不会超过1000

Question

这个问题来自here。我现在需要做的是在 SQL 中将 insert into 命令分解，这样我就不会超出限制。

这是我目前所拥有的：

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

保留值字符串中的记录计数，并在计数达到限制时执行语句。重置计数器并清除值字符串并在循环中重复。如果退出循环后仍有任何值，则执行最后一次执行。

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