Загрузка данных


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