Демонстрируется работа с набором записей в цикле, начаная от простейшего перебора записей фиксированной таблицы текущей базы с фиксированними полями и заканчивая работой с произвольной таблицей в произвольной базе данных.
Демонстрируется работа с набором записей в цикле, начаная от простейшего перебора записей фиксированной таблицы текущей базы с фиксированними полями и заканчивая работой с произвольной таблицей в произвольной базе данных.
Используtмые объекты
Таблица "tblPeoples" и модуль "mdl_Cycle" Текст модуля "mdl_Cycle"
'Количество записей в наборе записей Dim lngRecordCount As Long
' db - текушая база данных Set db = CurrentDb
Set rs = db.OpenRecordset("tblPeoples", dbOpenDynaset) ' rs - набор записей на основе таблицы "tblPeoples" ' При инициализации набора записей мы можем точно ' определить, есть ли в этом наборе записи или нет. ' Свойство "RecordCount" набора записей посли его ' инициализации, по идее, должна сождержать количество ' записей набора, однако это не так. Если в наборе есть ' записи это свойство отлично от нуля, но не содержит ' их количество. Для определения количества записей ' необходимо перейти на последнюю запись набора, и после ' этого в свойстве "RecordCount" будет находиться ' количество записей набора.
'Если в наборе rs есть записи... If rs.RecordCount <> 0 Then rs.MoveLast ' Переходим на последнюю запись (чтобы "RecordCount" ' содержало верное значение)
lngRecordCount = rs.RecordCount ' Считываем количество записей в переменную
rs.MoveFirst 'Переходим на первую запись набора ' Заполняем текстовую переменную str количеством записей str = "Количество записей в таблице ""tblPeoples"": " & lngRecordCount & vbCrLf
'Свойство EOF (End Of File) набора записей становиться истинным ПОСЛЕ последней записи набора, 'точно как и свойство BOF (Begin Of File) становиться истинным ПЕРЕД первой записью набора. 'Набор записей можно изобразить примерно так: ' ' BOF ' First Record ' ............ ' ............ ' ............ ' Last Record ' EOF ' 'Цикл "Пока не кончатся записи в наборе rs" Do Until rs.EOF 'Добавляем в переменную str имнена полей, их ' значения и символ перевода строки str = str & "ID_People: " & rs![ID_People] & vbCrLf str = str & "ID_RecordStatus: " & rs![ID_RecordStatus] & vbCrLf str = str & "LastName: " & rs![LastName] & vbCrLf str = str & "FirstName: " & rs![FirstName] & vbCrLf str = str & "MiddleName: " & rs![MiddleName] & vbCrLf str = str & "PeopleSex: " & rs![PeopleSex] & vbCrLf str = str & "BirthDate: " & rs![BirthDate] & vbCrLf str = str & "------------" & vbCrLf rs.MoveNext 'Переходим на следующую запись
Loop 'Конец цикла Else 'Если записей нет... ' Заполняем текстовую переменную str сообщением об ' отсутствии записей str = "Таблица ""tblPeoples"" не содержит записей." End If 'Печатаем содержимое переменной str в окне отладки Debug.Print str rs.Close 'Закрываем переменную набора записей
db.Close 'Закрываем переменную базы данных End Sub
'Заносим в переменную "lngFieldsCount" 'количество полей в записи lngFieldsCount = rs.Fields.Count
Do Until rs.EOF
' Цикл по полям текущей записи от 1-го до последнего. ' Нумерация полей начанается с нуля, ' поэтому цикл - ' от нуля до "количество записей минус один" For lngCurrentField = 0 To lngFieldsCount - 1
' Обращение к N-ому элементу (полю) семейства полей ' нашего набора выглядит так: rs.Fields(N) ' Имя поля храниться в свойстве Name: rs.Fields(N).Name ' Значение поля храниться в свойстве Value: ' rs.Fields(N).Value ' Добавляем в переменную str имя поля, его значение ' и символ перевода строки str = str & rs.Fields(lngCurrentField).Name & _ ": " & rs.Fields(lngCurrentField).Value & vbCrLf
Next lngCurrentField 'Конец цикла по полям текущей записи
'Добавляем в переменную str прочерк с переводом строки str = str & "------------" & vbCrLf
rs.MoveNext 'Переходим на следующую запись Loop 'Конец цикла по записям
Else str = "Таблица ""tblPeoples"" не содержит записей." End If Debug.Print str rs.Close db.Close End Sub
MsgBox Err.Description 'Выдаем сообщение об ошибке
Resume Exit_Cycle01_6 'Продолжаем работу с метки "Exit_Cycle01_6"
'Вызов процедуры без возникновения ошибки: ' Call Cycle01_6("tblPeoples") 'Вызов процедуры с возникновением ошибки: ' Call Cycle01_6("tblPeopleс") End Sub
Dim blTableIsPresent As Boolean 'Логическая переменная (флаг), 'показывающая наличие таблицы в базе Set db = CurrentDb blTableIsPresent = False '"Сбрасываем" флаг
'Цикл по всем таблицам текущей базы данных For Each tdf In db.TableDefs 'Если имя текущей таблицы совпадает с именем, 'переданным в процедуру... If tdf.Name = strTableName Then blTableIsPresent = True '"Устанавливаем" флаг ...
Exit For '... и выходим из цикла
End If Next tdf 'Конец цикла по таблицам
'Если флаг установлен (т.е. в предыдущем цикле ' была найдена таблица с интересующим нас именем)...
If blTableIsPresent = True Then Set rs = db.OpenRecordset(strTableName, dbOpenDynaset)
If rs.RecordCount <> 0 Then rs.MoveLast lngRecordCount = rs.RecordCount rs.MoveFirst str = _ "Количество записей в таблице """ & strTableName & _ """: " & lngRecordCount & vbCrLf Do Until rs.EOF For Each fldField In rs.Fields str = str & fldField.Name & ": " & _ fldField.Value & vbCrLf Next fldField str = str & "------------" & vbCrLf rs.MoveNext Loop Else str = "Таблица """ & strTableName & _ """ не содержит записей." End If
Debug.Print str
rs.Close Else 'Если таблица не была найдена... 'Выдаем соответствующее сообщение MsgBox "Таблица "" & strTableName & _ "" отсутствует в текущей базе данных.@@Повторите " & _ "вызов процедуры, указав правильно имя таблицы.", _ vbInformation, "Внимание!" End If db.Close Exit_Cycle01_7: Exit Sub Err_Cycle01_7: MsgBox Err.Description Resume Exit_Cycle01_7
'Вызов процедуры без возникновения ошибки: ' Call Cycle01_7("tblPeoples") 'Вызов процедуры с возникновением сообщения: ' Call Cycle01_7("tblPeopleс") End Sub
End If Next tdf Else 'Если в процедуру передано имя таблицы...
For Each tdf In db.TableDefs If tdf.Name = strTableName Then blTableIsPresent = True Exit For End If Next tdf End If If blTableIsPresent = True Then Set rs = db.OpenRecordset(strTableName, dbOpenDynaset)
If rs.RecordCount <> 0 Then rs.MoveLast lngRecordCount = rs.RecordCount rs.MoveFirst str = "Количество записей в таблице """ & _ strTableName & """: " & lngRecordCount & vbCrLf Do Until rs.EOF For Each fldField In rs.Fields str = str & fldField.Name & _ ": " & fldField.Value & vbCrLf Next fldField str = str & "------------" & vbCrLf rs.MoveNext Loop Else str = "Таблица """ & strTableName & _ """ не содержит записей." End If
Debug.Print str
rs.Close Else MsgBox "Таблица "" & strTableName & _ "" отсутствует в текущей базе данных.@@Повторите " & _ "вызов процедуры, указав правильно имя таблицы.", _ vbInformation, "Внимание!" End If db.Close Exit_Cycle01_8: Exit Sub Err_Cycle01_8: MsgBox Err.Description Resume Exit_Cycle01_8
'Вызов процедуры без возникновения ошибки: ' Call Cycle01_8("tblPeoples") 'Вызов процедуры без передачи параметра: ' Call Cycle01_8 End Sub
End If Next tdf Else 'Если в процедуру передано имя таблицы...
For Each tdf In db.TableDefs If tdf.Name = strTableName Then blTableIsPresent = True Exit For End If Next tdf End If If blTableIsPresent = True Then Set rs = db.OpenRecordset(strTableName, dbOpenDynaset)
If rs.RecordCount <> 0 Then rs.MoveLast lngRecordCount = rs.RecordCount rs.MoveFirst str = "Количество записей в таблице """ & _ strTableName & """: " & lngRecordCount & vbCrLf Do Until rs.EOF For Each fldField In rs.Fields str = str & fldField.Name & _ ": " & fldField.Value & vbCrLf Next fldField str = str & "------------" & vbCrLf rs.MoveNext Loop Else str = "Таблица """ & strTableName & _ """ не содержит записей." End If
Debug.Print str
rs.Close Else MsgBox "Таблица "" & strTableName & _ "" отсутствует в базе данных " & db.Name & _ ".@@Повторите вызов процедуры, указав правильно " & _ "имя таблицы.", vbInformation, "Внимание!" End If db.Close Exit_Cycle01_9: Exit Sub Err_Cycle01_9: MsgBox Err.Description Resume Exit_Cycle01_9
'Вызов процедуры c передачей параметров: 'Call Cycle01_9("tblPeoples","C:MyDataBase.mdb") 'Вызов процедуры без передачи параметров: 'Call Cycle01_9 End Sub