'This example uses CreateDatabase to create a new,
'encrypted Database object.
Sub CreateDatabaseX()
Dim wrkDefault As Workspace
Dim dbsNew As Database
Dim prpLoop As Property
' Get default Workspace.
Set wrkDefault = DBEngine.Workspaces(0)
' Make sure there isn't already a file with the name of
' the new database.
If Dir("NewDB.mdb") <> "" Then Kill "NewDB.mdb"
' Create a new encrypted database with the specified
' collating order.
Set dbsNew = wrkDefault.CreateDatabase("NewDB.mdb", _
dbLangGeneral, dbEncrypt)
With dbsNew
Debug.Print "Properties of " & .Name
' Enumerate the Properties collection of the new
' Database object.
For Each prpLoop In .Properties
If prpLoop <> "" Then Debug.Print " " & _
prpLoop.Name & " = " & prpLoop
Next prpLoop
End With
dbsNew.Close
End Sub
'This example creates a new TableDef object in the
'Northwind database.
Sub CreateTableDefX()
Dim dbsNorthwind As Database
Dim tdfNew As TableDef
Dim prpLoop As Property
Set dbsNorthwind = OpenDatabase("Northwind.mdb")
' Create a new TableDef object.
Set tdfNew = dbsNorthwind.CreateTableDef("Contacts")
With tdfNew
' Create fields and append them to the new TableDef
' object. This must be done before appending the
' TableDef object to the TableDefs collection of the
' Northwind database.
.Fields.Append .CreateField("FirstName", dbText)
.Fields.Append .CreateField("LastName", dbText)
.Fields.Append .CreateField("Phone", dbText)
.Fields.Append .CreateField("Notes", dbMemo)
Debug.Print "Properties of new TableDef object " & _
"before appending to collection:"
' Enumerate Properties collection of new TableDef
' object.
For Each prpLoop In .Properties
On Error Resume Next
If prpLoop <> "" Then Debug.Print " " & _
prpLoop.Name & " = " & prpLoop
On Error GoTo 0
Next prpLoop
' Append the new TableDef object to the Northwind
' database.
dbsNorthwind.TableDefs.Append tdfNew
Debug.Print "Properties of new TableDef object " & _
"after appending to collection:"
' Enumerate Properties collection of new TableDef
' object.
For Each prpLoop In .Properties
On Error Resume Next
If prpLoop <> "" Then Debug.Print " " & _
prpLoop.Name & " = " & prpLoop
On Error GoTo 0
Next prpLoop
End With
' Delete new TableDef object since this is a
' demonstration.
dbsNorthwind.TableDefs.Delete "Contacts"
dbsNorthwind.Close
End Sub
'This example uses either the Append method or the Delete method
'to modify the Fields collection of a TableDef.
'The AppendDeleteField procedure is required for this
'procedure to run.
Sub AppendX()
Dim dbsNorthwind As Database
Dim tdfEmployees As TableDef
Dim fldLoop As Field
Set dbsNorthwind = OpenDatabase("Northwind.mdb")
Set tdfEmployees = dbsNorthwind.TableDefs!Employees
' Add three new fields.
AppendDeleteField tdfEmployees, "APPEND", _
"E-mail", dbText, 50
AppendDeleteField tdfEmployees, "APPEND", _
"Http", dbText, 80
AppendDeleteField tdfEmployees, "APPEND", _
"Quota", dbInteger, 5
Debug.Print "Fields after Append"
Debug.Print , "Type", "Size", "Name"
' Enumerate the Fields collection to show the new fields.
For Each fldLoop In tdfEmployees.Fields
Debug.Print , fldLoop.Type, fldLoop.Size, fldLoop.Name
Next fldLoop
' Delete the newly added fields.
AppendDeleteField tdfEmployees, "DELETE", "E-mail"
AppendDeleteField tdfEmployees, "DELETE", "Http"
AppendDeleteField tdfEmployees, "DELETE", "Quota"
Debug.Print "Fields after Delete"
Debug.Print , "Type", "Size", "Name"
' Enumerate the Fields collection to show that the new
' fields have been deleted.
For Each fldLoop In tdfEmployees.Fields
Debug.Print , fldLoop.Type, fldLoop.Size, fldLoop.Name
Next fldLoop
dbsNorthwind.Close
End Sub
Sub AppendDeleteField(tdfTemp As TableDef, _
strCommand As String, strName As String, _
Optional varType, Optional varSize)
With tdfTemp
' Check first to see if the TableDef object is
' updatable. If it isn't, control is passed back to
' the calling procedure.
If .Updatable = False Then
MsgBox "TableDef not Updatable! " & _
"Unable to complete task."
Exit Sub
End If
' Depending on the passed data, append or delete a
' field to the Fields collection of the specified
' TableDef object.
If strCommand = "APPEND" Then
.Fields.Append .CreateField(strName, _
varType, varSize)
Else
If strCommand = "DELETE" Then .Fields.Delete _
strName
End If
End With
End Sub
Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 0