VBA/Excel/Access/Word/Access/Table Create
Версия от 16:33, 26 мая 2010; (обсуждение)
Содержание
- 1 Adding a Single-Field Index to an Existing Table with SQL command
- 2 Create a table with validation rule
- 3 Creating an Index Based on Two Fields with SQL command
- 4 Creating a Table (ADOX data types vs. Microsoft Access data types)
- 5 Creating a Table in a New Database with AUTOINCREMENT column
- 6 Creating a Table in the Current Database with SQL statement
- 7 Creating a Table with a Single-Field Index with SQL command
- 8 Creating Check Constraints:add business rules for a table
- 9 Default Column value
Adding a Single-Field Index to an Existing Table with SQL command
Sub SingleField_Index2()
Dim conn As ADODB.Connection
Dim strTable As String
On Error GoTo ErrorHandler
Set conn = CurrentProject.Connection
strTable = "myTable"
conn.Execute "CREATE INDEX idxCity ON " & strTable & "(SCity) ;"
ExitHere:
conn.Close
Set conn = Nothing
Exit Sub
ErrorHandler:
MsgBox Err.Number & ":" & Err.Description
Resume ExitHere
End Sub
Create a table with validation rule
Sub exaCreateTable()
Dim db As Database
Dim tblNew As TableDef
Dim fld As Field
Set db = CurrentDb
Set tblNew = db.CreateTableDef("NewTable")
Set fld = tblNew.CreateField("NewField", dbText, 100)
fld.AllowZeroLength = True
fld.DefaultValue = "Unknown"
fld.Required = True
fld.ValidationRule = "Instr$(Like "A*" or Like "Unknown""
fld.ValidationText = "Known value must begin with A"
tblNew.Fields.Append fld
db.TableDefs.Append tblNew
End Sub
Creating an Index Based on Two Fields with SQL command
Sub MultiField_Index()
Dim conn As ADODB.Connection
Dim strTable As String
On Error GoTo ErrorHandler
Set conn = CurrentProject.Connection
strTable = "myTable"
conn.Execute "CREATE TABLE " & strTable _
& "(SId INTEGER, " _
& "SName CHAR (30), " _
& "SCity CHAR (19), " _
& "CONSTRAINT idxSupplierNameCity UNIQUE " _
& "(SName, SCity));"
Application.RefreshDatabaseWindow
ExitHere:
conn.Close
Set conn = Nothing
Exit Sub
ErrorHandler:
Debug.Print Err.Number & ":" & Err.Description
Resume ExitHere
End Sub
Creating a Table (ADOX data types vs. Microsoft Access data types)
ADOX Data Type Corresponding Data Type in Access
adBoolean Yes/No
adUnsignedTinyInt Number (FieldSize = Byte)
adSmalIInt Number (FieldSize = Integer)
adSingle Number (FieldSize = Single)
adDouble Number (FieldSize = Double)
adDecimal Number (FieldSize = Decimal)
adInteger Number (FieldSize = LongInteger)
AutoNumber
adCurrency Currency
adVarWChar Text
adDate Date/Time
adLongVarBinary OLE Object
dbMemo Memo
adLongVarWChar Hyperlink
" make sure to set up a reference to
" the Microsoft ADO Ext. 2.5 for DDL and Security
" Object Library
Sub Create_Table()
Dim cat As ADOX.Catalog
Dim myTable As ADOX.Table
On Error GoTo ErrorHandler
Set cat = New Catalog
cat.ActiveConnection = CurrentProject.Connection
Set myTable = New Table
With myTable
.Name = "vbexTable"
With .Columns
.Append "Id", adVarWChar, 10
.Append "Description", adVarWChar, 255
.Append "Type", adInteger
End With
End With
cat.Tables.Append myTable
Set cat = Nothing
MsgBox "The new table "vbexTable" was created."
Exit Sub
ErrorHandler:
If Err.Number = -2147217857 Then
cat.Tables.Delete "vbexTable"
Resume
End If
MsgBox Err.Number & ": " & Err.Description
End Sub
Creating a Table in a New Database with AUTOINCREMENT column
Sub CreateTableInNewDb()
Dim cat As ADOX.Catalog
Dim conn As ADODB.Connection
Dim strDb As String
Dim strTable As String
Dim strConnect As String
On Error GoTo ErrorHandler
Set cat = New ADOX.Catalog
strDb = CurrentProject.Path & "\mydb.mdb"
strConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDb
cat.Create strConnect
Set conn = cat.ActiveConnection
conn.Execute "CREATE TABLE myTable(SchoolId AUTOINCREMENT(100, 5)," & _
"SchoolName CHAR,City Char (25), District Char (35),YearEstablished Date);"
ExitHere:
Set cat = Nothing
Set conn = Nothing
Exit Sub
ErrorHandler:
If Err.Number = -2147217897 Then
Kill strDb
Resume 0
Else
Debug.Print Err.Number & ": " & Err.Description
GoTo ExitHere
End If
End Sub
Creating a Table in the Current Database with SQL statement
Sub CreateTable()
Dim conn As ADODB.Connection
Dim strTable As String
On Error GoTo ErrorHandler
Set conn = CurrentProject.Connection
strTable = "Employees"
conn.Execute "CREATE TABLE " & strTable & _
"(Id AUTOINCREMENT(100, 5)," & _
"lName CHAR," & _
"City Char (25), District Char (35)," & _
"YearEstablished Date);"
Application.RefreshDatabaseWindow
ExitHere:
conn.Close
Set conn = Nothing
Exit Sub
ErrorHandler:
MsgBox Err.Number & ":" & Err.Description
Resume ExitHere
End Sub
Creating a Table with a Single-Field Index with SQL command
Sub SingleField_Index()
Dim conn As ADODB.Connection
Dim strTable As String
On Error GoTo ErrorHandler
Set conn = CurrentProject.Connection
strTable = "myTable"
conn.Execute "CREATE TABLE " & strTable _
& "(Id INTEGER, " _
& "SName CHAR (30), " _
& "CONSTRAINT idxSupplierName UNIQUE " _
& "(SName));"
Application.RefreshDatabaseWindow
ExitHere:
conn.Close
Set conn = Nothing
Exit Sub
ErrorHandler:
Debug.Print Err.Number & ":" & Err.Description
Resume ExitHere
End Sub
Creating Check Constraints:add business rules for a table
Sub CreateCheckConstraint()
Dim cmd As ADODB.rumand
Set cmd = New ADODB.rumand
cmd.ActiveConnection = CurrentProject.Connection
cmd.rumandText = "CREATE TABLE Customers1 " & _
"(CustomerID LONG CONSTRAINT CustomerID PRIMARY KEY, " & _
"CompanyName TEXT (50), IntroDate DATETIME, " & _
"CONSTRAINT IntroDateCheck CHECK (IntroDate <= Date()), " & _
"CreditLimit CURRENCY DEFAULT 5000)"
cmd.Execute
End Sub
Default Column value
Sub CreateDefault()
Dim cmd As ADODB.rumand
Set cmd = New ADODB.rumand
cmd.ActiveConnection = CurrentProject.Connection
cmd.rumandText = "CREATE TABLE Customers " & _
"(CustomerID LONG CONSTRAINT CustomerID PRIMARY KEY, " & _
"CompanyName TEXT (50), IntroDate DATETIME, " & _
"CreditLimit CURRENCY DEFAULT 5000)"
cmd.Execute
End Sub