Cat On A Spreadsheet

Cat On A Spreadsheet

Bulk Insert from an Excel Table to SQL Server Using Parameterized Commands, Chunked Transactions, Error Logging, and Email Notification

Moving data from Excel into SQL Server is one of the most common enterprise-grade VBA automation tasks — and it is also one of the most error-sensitive. Users frequently paste or import extremely large transactional datasets into Excel, run a macro, and expect all of those rows to be reliably loaded into SQL Server. Unfortunately, most of the code floating around online is either slow (because it inserts rows one row at a time with a new SQL call each time), or dangerously constructed (because it concatenates raw SQL strings and exposes you to SQL injection), or worse — both.

 

A robust pattern needs to satisfy three requirements simultaneously: the inserts must be secure, the inserts must be fast, and the inserts must be observable. In this post we implement a design that satisfies all three. We will read from an Excel Table (ListObject) named tblDataLoad, and insert its rows into a SQL Server table called dbo.ImportData. We will use a parameterized command structure so that SQL injection is impossible and types remain stable. We will execute inserts in chunked batches wrapped inside database transactions so that performance remains reasonable even with tens of thousands of rows. Finally, we will integrate with the previous error logging and email notification module so that if anything goes wrong, the failure is logged to a timestamped log file and the log is emailed to VBAdmin@company.com automatically.

 

The hybrid parameterized and chunked approach is ideal for this kind of controlled, medium-to-large volume load scenario. Each chunk commits its own transaction, so if a single chunk encounters a failure, the damage is isolated. Smaller chunk sizes improve reliability and reduce the cost of rollbacks, while larger chunk sizes improve throughput at the expense of resource load. Reasonable chunk sizes are usually between 200 and 2000 rows depending on environment, server and network IO characteristics, and transaction log settings.

 

The code below demonstrates the full pattern. The mapping between Excel column headers and SQL column names is declared explicitly, because relying on implicit column ordering is too fragile and cannot safely be maintained long-term. The macro reuses a prepared parameterized command object so that parameter creation costs are not repeated unnecessarily. And when the macro completes successfully with no errors, the success message returns immediately. If there were any errors during any chunk, the ErrorHandler module handles the persistence of those errors, creates a timestamped log file, and emails the contents automatically.

Option Explicit

Public Sub BulkInsertFromTable(ByVal tableName As String, Optional ByVal chunkSize As Long = 500)
     On Error GoTo ErrHandler
     Dim lo As ListObject
     Dim ws As Worksheet
     Dim conn As Object ' ADODB.Connection
     Dim cmd As Object ' ADODB.Command
     Dim r As Long, totalRows As Long
     Dim startRow As Long, endRow As Long
     Dim tblCols As Variant
     Dim mapping As Variant

     Set lo = Nothing
     For Each ws In ThisWorkbook.Worksheets
         On Error Resume Next
         Set lo = ws.ListObjects(tableName)
         On Error GoTo ErrHandler
         If Not lo Is Nothing Then Exit For
     Next ws

     If lo Is Nothing Then
         Err.Raise 99999, "BulkInsertFromTable", "Table '" & tableName & "' not found."
     End If

     tblCols = Application.Transpose(lo.HeaderRowRange.Value)
     mapping = Array( _
         Array("Date", "TransactionDate"), _
         Array("Account", "AccountCode"), _
         Array("Amount", "Amount"), _
         Array("Comment", "Comment") _
     )

     totalRows = lo.ListRows.Count
     If totalRows = 0 Then Exit Sub

     Set conn = GetDBConnection()
     If conn Is Nothing Then
         Err.Raise 99998, "BulkInsertFromTable", "Unable to obtain DB connection."
     End If

     Set cmd = CreateObject("ADODB.Command")
     With cmd
         .ActiveConnection = conn
         .CommandType = 1
         .CommandText = "INSERT INTO dbo.ImportData (TransactionDate, AccountCode, Amount, Comment) VALUES (?,?,?,?)"
         .Parameters.Append .CreateParameter("pDate", 135, 1)
         .Parameters.Append .CreateParameter("pAccount", 200, 1, 50)
         .Parameters.Append .CreateParameter("pAmount", 5, 1)
         .Parameters.Append .CreateParameter("pComment", 200, 1, 255)
     End With

     startRow = 1
     Do While startRow <= totalRows
         endRow = Application.Min(startRow + chunkSize - 1, totalRows)
         conn.BeginTrans
         Dim vDate As Variant, vAccount As Variant, vAmount As Variant, vComment As Variant
         Dim rIdx As Long
         For rIdx = startRow To endRow
             vDate = lo.ListColumns("Date").DataBodyRange.Cells(rIdx).Value
             vAccount = lo.ListColumns("Account").DataBodyRange.Cells(rIdx).Value
             vAmount = lo.ListColumns("Amount").DataBodyRange.Cells(rIdx).Value
             vComment = lo.ListColumns("Comment").DataBodyRange.Cells(rIdx).Value

             cmd.Parameters(0).Value = IIf(IsDate(vDate), CDate(vDate), Null)
             cmd.Parameters(1).Value = IIf(vAccount = "", Null, CStr(vAccount))
             cmd.Parameters(2).Value = IIf(IsNumeric(vAmount), CDbl(vAmount), Null)
             cmd.Parameters(3).Value = IIf(vComment = "", Null, CStr(vComment))

             cmd.Execute , , 128
         Next rIdx
         conn.CommitTrans
         startRow = endRow + 1
     Loop

     If Not conn Is Nothing Then conn.Close
     Set cmd = Nothing
     Set conn = Nothing

     ErrorHandler.FlushErrors
     MsgBox "Bulk insert completed successfully (" & totalRows & " rows).", vbInformation
     Exit Sub

ErrHandler:
     On Error Resume Next
     If Not conn Is Nothing Then
         If conn.InTransaction Then conn.RollbackTrans
     End If
     ErrorHandler.LogError "BulkInsertFromTable", Erl
     ErrorHandler.FlushErrors
     If Not conn Is Nothing Then conn.Close
     Set cmd = Nothing
     Set conn = Nothing
     MsgBox "Bulk insert failed. Admin has been notified.", vbCritical
End Sub

 

When running the above code for the first time, you will probably want to start with a small chunk size to prove the pipeline is stable, then gradually tune up. Chunk sizes determine the tradeoff point between IO throughput and risk concentration. Large chunks improve raw speed, but if one record in the chunk is malformed the entire chunk rolls back. Very small chunks make error isolation trivial but can destroy performance. Over time you will find the optimal balance for your environment, and that value will often differ between departments or workloads because network constraints are rarely uniform across an organization.

 

The most powerful aspect of this pattern is that each layer is independently improvable. The connection layer can be upgraded to use ADAL / modern auth without changing the rest. The mapping structure can be expanded automatically from named ranges or metadata sources. The logging module can be extended to automatically dump SQL Server constraint errors into a dedicated diagnostic table for analysis. And the email notification pipeline means that when failures occur, the development team knows immediately, rather than waiting weeks until a user finally mentions something “looked wrong”.

This approach is the difference between VBA code that feels temporary and code that feels like an actual controlled system integration engine.

03 November 2025

Full Service Consulting

Reporting

Automation

Cat On A Spreadsheet

Cat On A Spreadsheet