Перебор всех записей (DAO)
Dim rst As DAO.Recordset
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", 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
s = "SELECT * FROM dtItemsFiles WHERE (itfSizeBytes=0)"
Set rst = CurrentDb.OpenRecordset(s, dbOpenDynaset)
With rst
Do Until .EOF = True
s = !itfName
s = CurrentProject.Path & conFileStorige & s
If Dir(s) <> "" Then
.Edit
lFileLen = FileLen(s)
!itfSizeBytes = lFileLen
.Update
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
|