Public Function fff()
t1 = Timer
' описываем переменные
Dim db As Database
Dim varArray() As Variant
Dim rstData As DAO.Recordset
Dim strSQL As String
Dim eData As Long
Dim intFields As Integer, i As Long
Dim rst As New ADODB.Recordset

Set db = CurrentDb
' задаем текст запроса
strSQL = "SELECT * from t_torrents"
' число полей в запросе
intFields = 8
' открываем рекордсет
Set rstData = db.OpenRecordset(strSQL)
' проверяем наличие записей
If rstData.RecordCount = 0 Then
    rstData.Close
    MsgBox "Таблица пустая!" _
           , 64, "Содержимое таблицы"
    Exit Function
End If
' определяем количество записей в рекордсете
rstData.MoveLast ' перемещение в конец рекордсета
rstData.MoveFirst ' перемещение в начало рекордсета
eData = rstData.RecordCount ' количество записей в рекордсете
ReDim varArray(intFields, eData) ' устанавливаем размер динамического массива
' первый параметр - число столбцов в массиве (полей в запросе)
' второй параметр - число строк в массиве (число записей в запросе)

' сброс данных из рекордсета в массив
varArray = rstData.GetRows(eData)

rstData.Close
Set rstData = Nothing
Debug.Print Timer - t1
t2 = Timer
rst.Fields.Append "id", adVarChar, 255
rst.Fields.Append "forum_id", adVarChar, 255
rst.Fields.Append "forum_name", adVarChar, 255
rst.Fields.Append "torrent_id", adVarChar, 255
rst.Fields.Append "info_hash", adVarChar, 255
rst.Fields.Append "torrent_name", adVarChar, 255
rst.Fields.Append "torrent_size", adVarChar, 255
rst.Fields.Append "torrent_date", adVarChar, 255
rst.Open
For i = 0 To eData - 1
    If InStr(1, varArray(5, i), "raime") > 0 Then
        'Debug.Print varArray(5, i)
        rst.AddNew
        rst.Fields(0) = varArray(0, i)
        rst.Fields(1) = varArray(1, i)
        rst.Fields(2) = varArray(2, i)
        rst.Fields(3) = varArray(3, i)
        rst.Fields(4) = varArray(4, i)
        rst.Fields(5) = varArray(5, i)
        rst.Fields(6) = varArray(6, i)
        rst.Fields(7) = varArray(7, i)
    End If
Next i
rst.UpdateBatch
Debug.Print Timer - t2
End Function