TopPicLogo TopPicText

Создание Таблиц

Простейший пример кода, который создает таблицу дней недели ("tempWeekDays") с порядковым номером в поле "DayID" и названием дня в поле "DayName"

Private Sub CreateWeekDaysTable()
'es 08.01.2013
'Создание Таблицы (Список дней недели)
'--------------------------------------------------------------------
Const strTableName As String = "tempWeekDays" 'Название таблицы
Dim tbl As TableDef       'объект таблица
Dim idx As Index          'объект индекс
Dim fld As Field          'объект поле
Dim rst As Recordset      'объект набор записей
Dim i As Integer          'счетчик дней

'Удаяем прошлое
    On Error Resume Next
    CurrentDb.TableDefs.Delete strTableName
    Err.Clear
    
On Error GoTo CreateWeekDaysTableErr

'создание объектной переменной таблицы, полей и индекса в ней
    Set tbl = CurrentDb.CreateTableDef(strTableName)
    With tbl
        .Fields.Append tbl.CreateField("DayID", dbLong)
        .Fields.Append tbl.CreateField("DayName", dbText, 20)
            'создание уникального индекса
            Set idx = .CreateIndex("Primary Key")
                With idx
                    'добавление поля в индекс
                    .Fields.Append .CreateField("DayID")
                    'Установка свойств индекса
                    .Unique = True   'Уникальный
                    .Primary = True  'Первичный
                End With
            .Indexes.Append idx
           'индекс создан
    End With
'Фактическое добавление таблицы из объектной переменной описанной выше
    CurrentDb.TableDefs.Append tbl


'Заполнение таблицы данными
    Set rst = CurrentDb.OpenRecordset(strTableName, dbOpenDynaset)
    With rst
        For i = 1 To 7
            .AddNew
            !DayID = i
            !DayName = DayName(i)
            .Update
        Next i
    End With

CreateWeekDaysTableBye:
    On Error Resume Next
    Set idx = Nothing
    Set tbl = Nothing
    rst.Close
    Set rst = Nothing
    Exit Sub

CreateWeekDaysTableErr:
    MsgBox "Произошла ошибка при выполнении процедуры " & _
    "[CreateWeekDaysTable] :" & vbCrLf & _
    Err.Description & vbCrLf & _
    "Номер ошибки = " & Err.Number, vbCritical
    Resume CreateWeekDaysTableBye
End Sub

'--------------------------------------------------------------------

Private Function DayName(DayNo As Integer) As String
'es 26.10.2000
'Вспомагательная = Возвращает название дня недели по его номеру
'--------------------------------------------------------------------
On Error GoTo DayNameErr
    Select Case DayNo
        Case 1: DayName = "Понедельник"
        Case 2: DayName = "Вторник"
        Case 3: DayName = "Среда"
        Case 4: DayName = "Четверг"
        Case 5: DayName = "Пятница"
        Case 6: DayName = "Суббота"
        Case 7: DayName = "Воскресенье"
    End Select
DayNameBye:     Exit Function
DayNameErr:     DayName = "#Error#": Resume DayNameBye
End Function

Назад ToTop
L.E. 08.01.2013
Рейтинг@Mail.ru