VBA, чтобы быстро вставить много записей в БД доступа

Итак, у меня есть электронная таблица, которая производит достаточно большое количество записей (~ 3500)

У меня есть следующий скрипт, который вставляет их в мою базу данных доступа:

Sub putinDB()
Dim Cn As ADODB.Connection, Rs As ADODB.Recordset
Dim MyConn, sSQL As String

Dim Rw As Long, c As Long
Dim MyField, Result
Dim x As Integer
Dim accName As String, AccNum As String, sector As String, holding As String,  holdingvalue As Double, holdingdate As Date
theend = lastRow("Holdings", 1) - 1
'Set source
MyConn = "S:\Docs\Harry\Engine Client\Engine3.accdb"
'Create query
Set r = Sheets("Holdings").Range("a2")
x = 0
Do
Application.StatusBar = "Inserting record " & x + 1 & " of " & theend
accName = r.Offset(x, 0)
AccNum = r.Offset(x, 4)
sector = r.Offset(x, 2)
holding = r.Offset(x, 1)
holdingvalue = r.Offset(x, 3)
holdingdate = r.Offset(x, 5)

sSQL = "INSERT INTO Holdings (AccName, AccNum, Sector, Holding, HoldingValue, HoldingDate)"
sSQL = sSQL & " VALUES ('" & Replace(accName, "'", "''") & "', '" & AccNum & "', '" & sector & "', '" & Replace(holding, "'", "''") & "', '" & holdingvalue & "', #" & holdingdate & "#)"
Debug.Print (sSQL)
 'Create RecordSet
Set Cn = New ADODB.Connection
With Cn
    .Provider = "Microsoft.ACE.OLEDB.12.0"
    .CursorLocation = adUseClient
    .Open MyConn
    Set Rs = .Execute(sSQL)
End With
x = x + 1
Loop While r.Offset(x, 0)  "" Or x < 15
Application.StatusBar = False
End Sub

Проблема в том, что он последовательно просматривает каждую запись, перестраивает и выполняет запрос каждый раз, что приводит к очень медленному выполнению (около 2-3 записей в секунду на моем ПК).

Есть ли способ сделать так, чтобы vba вставляла весь диапазон в БД за один раз, не проходя цикл? Спасибо

Ответы на вопрос(2)

Ваш ответ на вопрос