Перебор всех записей (DAO)
Dim rst As DAO.Recordset
'Set rst = CurrentDb.OpenRecordset("tblExample", dbOpenDynaset) 'Открытие на редакцию
Set rst = CurrentDb.OpenRecordset("tblExample", dbOpenSnapshot) 'Только просмотр
'Перебор всех записей в наборе
With rst
Do Until .EOF = True 'Цикл до конца набора
'Тут операции с записью:
'...
.MoveNext
Loop
End With
On Error Resume Next
rst.Close
Set rst = Nothing
Или так:
Private Sub AllRecordsInRecordset()
Dim rst As DAO.Recordset
On Error GoTo AllRecordsInRecordsetErr
'Set rst = CurrentDb.OpenRecordset("tblExample", dbOpenDynaset) 'Открытие на редакцию
Set rst = CurrentDb.OpenRecordset("tblExample", dbOpenSnapshot) 'Только просмотр
'Перебор всех записей в наборе
With rst
Do Until .EOF = True 'Цикл до конца набора
'Тут операции с записью:
'...
.MoveNext
Loop
End With
AllRecordsInRecordsetEnd:
On Error Resume Next
rst.Close
Set rst = Nothing
Exit Sub
AllRecordsInRecordsetErr:
MsgBox "Процедура [...] привела к ошибке:" & vbCrLf & _
Err.Description & vbCrLf & " Err#" & Err.Number, vbCritical
Resume AllRecordsInRecordsetEnd
End Sub
Пример перебора записей с обновлением данных таблицы:
Private Sub FileSizesToTable()
'Установка размеров файлов в таблице файлов
'--------------------------------------------------------------------------
Dim rst As DAO.Recordset
Dim lFileLen As Long
Dim s$
On Error GoTo FileSizesToTable_Err
'Выборка строк где размер файлов не проставлен (itfSizeBytes=0)
s = "SELECT * FROM dtItemsFiles WHERE (itfSizeBytes=0)"
Set rst = CurrentDb.OpenRecordset(s, dbOpenDynaset) 'Открытие на редакцию
With rst
Do Until .EOF = True 'Цикл до конца таблицы
'...операции с записью
s = !itfName 'Имя файла
'тут conFileStorige = относительная папка типа "\ProgectData\Files\"
s = CurrentProject.Path & conFileStorige & s 'получили полный путь к файлу
If Dir(s) <> "" Then 'если файл существует
.Edit ' ВКЛ. режим редактирования
lFileLen = FileLen(s) ' получаем размер файла в байтах
!itfSizeBytes = lFileLen ' и записываем его
.Update ' Сохранили ...
'Debug.Print Format(lFileLen, "000 000 000") & " - " & !itfName
End If
.MoveNext 'Переход к следующей записи
Loop
End With
FileSizesToTable_End:
On Error Resume Next
rst.Close
Set rst = Nothing
Exit Sub
FileSizesToTable_Err:
MsgBox "Процедура [FileSizesToTable] привела к ошибке:" & vbCrLf & _
Err.Description & vbCrLf & " Err#" & Err.Number, vbCritical, "Ошибка!"
Resume FileSizesToTable_End
End Sub
