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

Простейший пример кода, который создает таблицу дней недели ("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