MyTetra Share
Делитесь знаниями!
Перебор всех записей (DAO)
16.03.2019
23:43
Раздел: !Закладки - VBA - Access - msa.polarcom.ru - 04 Наборы Записей

Перебор всех записей (DAO)

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




 
MyTetra Share v.0.52
Яндекс индекс цитирования