Public Sub InsertFromExcel()
    Const strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Temp\REConclusion.accdb;Persist Security Info=True;Jet OLEDB:Database Password=123"
    Dim sSQL As String
    Dim pConn As New ADODB.Connection, pSheet As Worksheet, lRow As Long
    Set pSheet = ThisWorkbook.Worksheets("Пример")
    lRow = pSheet.Cells(pSheet.Rows.Count, 2).End(xlUp).Row
     
    sSQL = "Insert Into Test (DateBD, NumberBD, TextMoreThan510, Quantity, CheckEmptyData) Select [Поле менее 510 знаков в ячейке (Дата)]"
    sSQL = sSQL & ",[Поле менее 510 знаков в ячейке (Число)],[Поле более 510 знаков в ячейке (Текст)]"
    sSQL = sSQL & ",[Количество знаков ячеек в столбце E],[Проверка если данных в ячееке нет] From "
    sSQL = sSQL & "[Excel 12.0;Database=" & ThisWorkbook.FullName & ";HDR=Yes].[Пример$B2:G" & lRow & "] Where [Проверка если данных в ячееке нет] Is Not Null;"
    pConn.Open strConn
    pConn.Execute sSQL
    pConn.Close
End Sub

Sub Variant1()

'Подключение
Dim Con As ADODB.Connection
Set Con = New ADODB.Connection
Dim i As Integer
Dim IDCheck As Integer
With Con
   .Provider = "Microsoft.ACE.OLEDB.12.0"
    .ConnectionString = "Data Source=C:\REConclusion.accdb;Persist Security Info=True;Jet OLEDB:Database Password=123"
       .Open
End With
'Команда
Dim Cmd As ADODB.Command
Set Cmd = New ADODB.Command
Cmd.ActiveConnection = Con
'Строка
IDCheck = Worksheets("Пример").Range("B1").Value + 2
For i = 3 To IDCheck
        Cmd.CommandText = "insert into [TEST] " _
        & "(DateBD, NumberBD, TextMoreThan510, Quantity, CheckEmptyData)" _
        & "values(@DateBD, @NumberBD, @TextMoreThan510, @Quantity, @CheckEmptyData)"
        
    'Поле менее 510 знаков в ячейке (Дата)
    Cmd.Parameters.Append Cmd.CreateParameter("@DateBD", adDate, adParamInput)
    Cmd.Parameters("@DateBD").Value = Sheets("Пример").Cells(i, 3).Value
    
    'Поле менее 510 знаков в ячейке (Число)
    Cmd.Parameters.Append Cmd.CreateParameter("@NumberBD", adInteger, adParamInput)
    Cmd.Parameters("@NumberBD").Value = Sheets("Пример").Cells(i, 4).Value
    
    'Поле более 510 знаков в ячейке (Текст)
    Cmd.Parameters.Append Cmd.CreateParameter("@TextMoreThan510", adLongVarWChar, adParamInput, 2& ^ 31 - 1)
    Cmd.Parameters("@TextMoreThan510").Value = Sheets("Пример").Cells(i, 5).Value
    
    'Количество знаков ячеек в столбце E
    Cmd.Parameters.Append Cmd.CreateParameter("@Quantity", adInteger, adParamInput)
    Cmd.Parameters("@Quantity").Value = Sheets("Пример").Cells(i, 6).Value
    
    'Поле более 510 знаков в ячейке (Текст)
    Cmd.Parameters.Append Cmd.CreateParameter("@CheckEmptyData", adWChar, adParamInput, 255)
    Cmd.Parameters("@CheckEmptyData").Value = Sheets("Пример").Cells(i, 7).Value
    
    Cmd.Execute
    
Next i

End Sub

Sub Variant2()

'Подключение
Dim Con As ADODB.Connection
Set Con = New ADODB.Connection
Dim i As Integer
Dim IDCheck As Integer
With Con
   .Provider = "Microsoft.ACE.OLEDB.12.0"
    .ConnectionString = "Data Source=C:\REConclusion.accdb;Persist Security Info=True;Jet OLEDB:Database Password=123"
       .Open
End With
'Команда
Dim Cmd As ADODB.Command
Set Cmd = New ADODB.Command
Cmd.ActiveConnection = Con
'Строка
IDCheck = Worksheets("Пример").Range("B1").Value + 2
For i = 3 To IDCheck
        Cmd.CommandText = "insert into [TEST] " _
        & "(DateBD, NumberBD, TextMoreThan510, Quantity, CheckEmptyData)" _
        & "values(@DateBD, @NumberBD, @TextMoreThan510, @Quantity, @CheckEmptyData)"
       
    'Поле менее 510 знаков в ячейке (Дата)
    Cmd.Parameters("@DateBD").Type = adDate
    Cmd.Parameters("@DateBD").Value = Sheets("Пример").Cells(i, 3).Value
    
    'Поле менее 510 знаков в ячейке (Число)
    Cmd.Parameters("@NumberBD").Type = adInteger
    Cmd.Parameters("@NumberBD").Value = Sheets("Пример").Cells(i, 4).Value
    
    'Поле более 510 знаков в ячейке (Текст)
    Cmd.Parameters("@TextMoreThan510").Type = adWChar
    Cmd.Parameters("@TextMoreThan510").Value = Sheets("Пример").Cells(i, 5).Value
    
    'Количество знаков ячеек в столбце E
    Cmd.Parameters("@Quantity").Type = adInteger
    Cmd.Parameters("@Quantity").Value = Sheets("Пример").Cells(i, 6).Value
    
    'Поле более 510 знаков в ячейке (Текст)
    Cmd.Parameters("@CheckEmptyData").Type = adWChar
    Cmd.Parameters("@CheckEmptyData").Value = Sheets("Пример").Cells(i, 7).Value
    
    Cmd.Execute
    
Next i

End Sub