به نمونه های زیر یه نگاهی بندازید:
Public Function CreateDatabase(DBFullPath As String, InitialTable As String) As Boolean
'PURPOSE: Creates an access database, with one table. The
'table will have one numeric field, ID
'PARAMETERS: DBFULLPATH: FileName/Path of database to create
'InitialTable: Name of table to create
'RETURNS: TRUE IF SUCCESSFUL, FALSE OTHERWISE
Dim db As Database
Dim td As TableDef
Dim f As Field
On Error GoTo ErrorHandler
Set db = DBEngine.CreateDatabase(DBFullPath, dbLangGeneral)
Set td = db.CreateTableDef(InitialTable)
Set f = td.CreateField("ID", dbLong)
td.Fields.Append f
db.TableDefs.Append td
CreateDatabase = True
ErrorHandler:
If Not db Is Nothing Then db.Close
End Function
Sub CreateAccessDatabase(sDatabaseToCreate)
Dim catNewDB As ADOX.Catalog
Set catNewDB = New ADOX.Catalog
catNewDB.Create "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & sDatabaseToCreate & _
";Jet OLEDB:Engine Type=5;"
' Engine Type=5 = Access 2000 Database
' Engine Type=4 = Access 97 Database
Set catNewDB = Nothing
End Sub
Sub CreateAccessTable(sDatabaseToCreate)
Dim catDB As ADOX.Catalog
Dim tblNew As ADOX.Table
Set catDB = New ADOX.Catalog
' Open the catalog
catDB.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & sDatabaseToCreate
' Create new Table
Set tblNew = New ADOX.Table
tblNew.Name = "Contacts"
' First Create an Autonumber column, called ID.
' This is just for demonstration purposes.
' We could have done this below with all the other
' columns as well
Dim col As ADOX.Column
Set col = New ADOX.Column
With col
.ParentCatalog = catDB
.Type = adInteger ' adText does not exist
.Name = "ID"
.Properties("Autoincrement") = True
.Properties("Description") = "I am the Description " & _
"for the column"
End With
tblNew.Columns.Append col
' Now add the rest of the columns
With tblNew
' Create fields and append them to the
' Columns collection of the new Table object.
With .Columns
.Append "NumberColumn", adInteger
.Append "FirstName", adVarWChar
.Append "LastName", adVarWChar
.Append "Phone", adVarWChar
.Append "Notes", adLongVarWChar
End With
Dim adColNullable ' Is not defined in adovbs.inc,
' so we need to define it here.
' The other option is adColFixed with a value of 1
adColNullable = 2
With .Columns("FirstName")
.Attributes = adColNullable
End With
End With
' Add the new Table to the Tables collection of the database.
catDB.Tables.Append tblNew
Set col = Nothing
Set tblNew = Nothing
Set catDB = Nothing
End Sub
Private Sub Form_Load()
Dim sDatabaseName As String
sDatabaseName = "C:\MyNewDatabase.mdb"
' First call the Create Database method
CreateAccessDatabase sDatabaseName
' Then add a table and columns to this database
CreateAccessTable sDatabaseName
MsgBox "Database has been created successfully!"
End Sub
اینجا هم نمونه ی خوبی معرفی شده:
http://www.ArminaCo.com
قوانین ایجاد تاپیک در تالار
پاسخ با نقل قول