Option Explicit

Sub CopyRangeToRecordset()
    Dim Path As String, File As String, connStr As String, sql As String
    Dim rs As Object, conn As Object
    Dim rng As Range, cell As Range
    Dim i As Long, j As Long
    Dim rowData     As Variant
    Dim ws          As Worksheet
    On Error GoTo ErrorHandler

    ' Устанавливаем ссылку на активный рабочий лист
    Set ws = ActiveSheet

    ' Путь к папке, содержащей файл Excel
    Path = ThisWorkbook.Path & "\"

    ' Полный путь к файлу Excel
    File = Path & "To Update.xlsx"

    ' Инициализация ADODB.Connection
    Set conn = CreateObject("ADODB.Connection")

    ' Строка подключения к файлу Excel
    connStr = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
            "Data Source=" & File & ";" & _
            "Extended Properties=""Excel 12.0 Xml;HDR=NO;"""

    ' Открытие соединения с файлом Excel
    conn.Open connStr

    ' Инициализация ADODB.Recordset
    Set rs = CreateObject("ADODB.Recordset")

    ' SQL-запрос для выборки данных из первого листа (Лист1)
    sql = "SELECT * FROM [Sheet1$A3:H10000]"

    ' Открытие Recordset с использованием соединения и SQL-запроса
    ' Изменен тип курсора и блокировки
    rs.Open sql, conn, 3, 3

    ' Установите ссылку на диапазон данных (в этом примере, данные начинаются с A3)
    Set rng = ws.Range(ws.Cells(3, 1), ws.Cells(ws.Cells(ws.Rows.Count, "A").End(xlUp).Row, 8))

    ' Обход каждой строки диапазона данных
    For i = 1 To rng.Rows.Count

        ' Считывание данных из строки
        rowData = rng.Rows(i).Value

        ' Пример кода для добавления данных в Recordset
        rs.AddNew

        For j = 1 To UBound(rowData, 2)
            rs.Fields(j - 1).Value = rowData(1, j)
        Next j

        rs.Update
    Next i

    ' Закрытие Recordset (если это необходимо)
    rs.Close
    Set rs = Nothing

    ' Успешное завершение
    MsgBox "Данные успешно скопированы в Recordset."
    Exit Sub

ErrorHandler:

    ' Обработка ошибки и вывод информации в окно отладки
    Debug.Print "Ошибка " & Err.Number & ": " & Err.Description
    MsgBox "Произошла ошибка. Проверьте окно отладки для подробностей.", vbCritical

    ' Закрытие Recordset и соединения в случае ошибки
    On Error Resume Next

    If Not rs Is Nothing Then
        If rs.State = 1 Then rs.Close
        Set rs = Nothing
    End If

    If Not conn Is Nothing Then
        If conn.State = 1 Then conn.Close
        Set conn = Nothing
    End If

End Sub