|
|
Создадание таблицы с различными типами полей (DAO)
Private Sub CreateTableAndFields()
Dim strTableName As String
Dim tbl As DAO.TableDef
Dim fld As DAO.Field
strTableName = "Table_Test"
On Error Resume Next
CurrentDb.TableDefs.Delete strTableName
Err.Clear
On Error GoTo CreateTableAndFields_Err
Set tbl = CurrentDb.CreateTableDef(strTableName)
With tbl
.Fields.Append tbl.CreateField("fldText", dbText, 255)
.Fields.Append tbl.CreateField("fldMemo", dbMemo)
.Fields.Append tbl.CreateField("fldDouble", dbDouble)
.Fields.Append tbl.CreateField("fldLong", dbLong)
.Fields.Append tbl.CreateField("fldDate", dbDate)
.Fields.Append tbl.CreateField("fldCurrency", dbCurrency)
Set fld = tbl.CreateField("fldAutoKey", dbLong)
With fld
.Attributes = dbAutoIncrField
End With
.Fields.Append fld
.Fields.Append tbl.CreateField("fldBoolean", dbBoolean)
.Fields.Append tbl.CreateField("fldOLE", dbLongBinary)
Set fld = tbl.CreateField("fldHyperlink", dbMemo)
With fld
.Attributes = dbHyperlinkField
End With
.Fields.Append fld
.Fields.Append tbl.CreateField("fldAttachment", dbAttachment)
End With
CurrentDb.TableDefs.Append tbl
CurrentDb.TableDefs.Refresh
CreateTableAndFields_Bye:
On Error Resume Next
Set tbl = Nothing
Set fld = Nothing
Exit Sub
CreateTableAndFields_Err:
MsgBox "Произошла ошибка при выполнении процедуры " & _
"[CreateTable01] :" & vbCrLf & _
Err.Description & vbCrLf & _
"Номер ошибки = " & Err.Number, vbCritical
Err.Clear
Resume CreateTableAndFields_Bye
End Sub
|
|