Загрузка данных
Sub CreateFriendsTable()
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim fld As DAO.Field
Dim prp As DAO.Property
Dim rs As DAO.Recordset
Set db = CurrentDb()
' 1. Удаляем таблицу "Друзья", если она уже была создана ранее
On Error Resume Next
db.TableDefs.Delete "Друзья"
On Error GoTo 0
' 2. Создаем структуру новой таблицы
Set tdf = db.CreateTableDef("Друзья")
' Поле "№ п/п" (Счетчик)
Set fld = tdf.CreateField("№ п/п", dbLong)
fld.Attributes = dbAutoIncrField
tdf.Fields.Append fld
' Текстовые поля: Фамилия, Имя, Отчество
tdf.Fields.Append tdf.CreateField("Фамилия", dbText, 255)
tdf.Fields.Append tdf.CreateField("Имя", dbText, 255)
tdf.Fields.Append tdf.CreateField("Отчество", dbText, 255)
' Поле "Телефон" (Текстовый, размер 16)
Set fld = tdf.CreateField("Телефон", dbText, 16)
tdf.Fields.Append fld
' Поле "Дата рождения" (Дата/Время)
Set fld = tdf.CreateField("Дата рождения", dbDate)
tdf.Fields.Append fld
' Поля "Увлечения" и "Адрес" (Текстовые)
tdf.Fields.Append tdf.CreateField("Увлечения", dbText, 255)
tdf.Fields.Append tdf.CreateField("Адрес", dbText, 255)
' Поле "Индекс" (Числовой)
tdf.Fields.Append tdf.CreateField("Индекс", dbLong)
' Поле "Эл_почта" (Гиперссылка - в DAO это Memo со специальным атрибутом)
Set fld = tdf.CreateField("Эл_почта", dbMemo)
fld.Attributes = dbHyperlinkField
tdf.Fields.Append fld
' Поле "Семейное положение" (Текстовый)
Set fld = tdf.CreateField("Семейное положение", dbText, 50)
tdf.Fields.Append fld
' Сохраняем созданную таблицу в базе данных
db.TableDefs.Append tdf
' 3. Настройка расширенных свойств полей (маски, форматы, списки)
' Настройка маски ввода для поля "Телефон"
Set fld = tdf.Fields("Телефон")
Set prp = fld.CreateProperty("InputMask", dbText, """+7"" 000"" ""000"" ""00"" ""00;0;")
fld.Properties.Append prp
' Настройка формата для поля "Дата рождения"
Set fld = tdf.Fields("Дата рождения")
Set prp = fld.CreateProperty("Format", dbText, "Short Date")
fld.Properties.Append prp
' Настройка Мастера подстановок (выпадающего списка) для "Семейного положения"
Set fld = tdf.Fields("Семейное положение")
Set prp = fld.CreateProperty("DisplayControl", dbInteger, 111) ' 111 = acComboBox
fld.Properties.Append prp
Set prp = fld.CreateProperty("RowSourceType", dbText, "Value List")
fld.Properties.Append prp
Set prp = fld.CreateProperty("RowSource", dbText, "замужем;не замужем;женат;не женат")
fld.Properties.Append prp
' 4. Заполнение таблицы данными (пример первых 3-х записей)
Set rs = db.OpenRecordset("Друзья")
' Запись 1
rs.AddNew
rs!Фамилия = "Иванов"
rs!Имя = "Алексей"
rs!Отчество = "Петрович"
rs![Дата рождения] = #10/12/1995#
rs!Адрес = "ул. Ленина, д. 12, кв. 5"
rs!Индекс = 101000
rs!Телефон = "+78786766565"
rs!Увлечения = "Фотография"
rs!Эл_почта = "alex.ivanov@example.com#mailto:alex.ivanov@example.com#"
rs![Семейное положение] = "женат"
rs.Update
' Запись 2
rs.AddNew
rs!Фамилия = "Петрова"
rs!Имя = "Мария"
rs!Отчество = "Ивановна"
rs![Дата рождения] = #5/23/1998#
rs!Адрес = "пр. Мира, 34"
rs!Индекс = 105120
rs!Телефон = "+79994735635"
rs!Увлечения = "Теннис"
rs!Эл_почта = "m.petrova@mail.ru#mailto:m.petrova@mail.ru#"
rs![Семейное положение] = "не замужем"
rs.Update
' Запись 3
rs.AddNew
rs!Фамилия = "Смирнов"
rs!Имя = "Дмитрий"
rs!Отчество = "Александрович"
rs![Дата рождения] = #8/5/1990#
rs!Адрес = "ул. Гагарина, 7"
rs!Индекс = 109456
rs!Телефон = "+70938474857"
rs!Увлечения = "Шахматы"
rs!Эл_почта = "smirnov_d@yandex.ru#mailto:smirnov_d@yandex.ru#"
rs![Семейное положение] = "не женат"
rs.Update
rs.Close
MsgBox "Структура базы данных успешно сгенерирована, таблица заполнена!", vbInformation
End Sub