Como hago relaciones de tablas en visual basic 6
Como relaciono tablas de access en visual basic 6, ya las tengo relacionadas en access.
1 respuesta
Respuesta de amallolm
1
1
En el siguiente código podrás obtener la información que me solicitas:
Creación de Bases de Datos en RunTime.
'
'Procedimiento para crear una DB y tablas asociadas en runtime
'
Const DbPath As String = "acuario2.mdb"
'Definición de la Base de Datos
Dim NewDb As Database
Dim Ws As Workspace
'Primero se crea un espacio de trabajo
Set Ws = DBEngine.Workspaces(0)
Dim DbOpciones As Long
'la DB será en formato Access 2.0 y estará encriptada
DbOpciones = dbVersion20 + dbEncrypt
'Esto crea la DB
Set NewDb = Ws.CreateDatabase(DbPath, dbLangGeneral, DbOpciones)
'Definición de una tabla
Dim NewTb As TableDef
'Aquí se crea una tabla en el DB
Set NewTb = NewDb.CreateTableDef("Articulos")
'Se establece una normativa en la tabla que es que la cantidad mínima a
'tener debe de ser mayor o igual a 0
NewTb.ValidationRule = "CantidadMinima >= 0"
'Mensaje de error si no se cumple la regla anterior
NewTb.ValidationText = "La cantidad mínima debe ser mayor o igual a 0"
'Definición de los campos de la tabla
'La tabla de artículos va a constar de 7 campos diferentes
ReDim Campo(1 To 9) As Field
'Definición del primer campo de la tabla
Set Campo(1) = NewTb.CreateField("Articulo", dbLong)
'Idem del segundo campo
Set Campo(2) = NewTb.CreateField("Descripcion", dbText, 50)
'Ídem del tercer campo. Las propiedades se establecen de forma explícita,
'en vez de usar los argumentos de CreateField
Set Campo(3) = NewTb.CreateField()
Campo(3).Name = "Categoria"
Campo(3).Type = dbText
Campo(3).Size = 10
Set Campo(4) = NewTb.CreateField("Mayorista", dbSingle)
'Se establecen propiedades de validación del campo
Campo(4).ValidationRule = "[Mayorista]>0"
Campo(4).ValidationText = "El precio de mayorista debe ser mayor que 0"
Set Campo(5) = NewTb.CreateField("Minorista", dbSingle)
Set Campo(6) = NewTb.CreateField("CantidadMinima", dbInteger)
Set Campo(7) = NewTb.CreateField()
Campo(7).Name = "Disponible"
Campo(7).Type = dbInteger
Set Campo(8) = NewTb.CreateField("Proveedor", dbLong)
Set Campo(9) = NewTb.CreateField("Fotografia", dbLongBinary)
'Se añaden los campos a la definición de la tabla
Dim i As Byte
For i = 1 To 9
NewTb.Fields.Append Campo(i)
Next i
'Definición de los índices de la tabla
Dim IdxArticulo As Index, IdxMayorista As Index
Dim CampoArticulo As Field, CampoMayorista As Field
'Primero se crea un índice
Set IdxArticulo = NewTb.CreateIndex("Articulo")
'y se establece que va a ser el índice primario
IdxArticulo.Primary = True
'Se crea un campo que va ser el que forma el índice
Set CampoArticulo = IdxArticulo.CreateField("Articulo")
'y se añade el campo al índice.
IdxArticulo.Fields.Append CampoArticulo
'Se crea otro índice para la tabla
Set IdxMayorista = NewTb.CreateIndex("PrecioPagado")
'y se establece que va no va a ser de tipo único
IdxMayorista.Unique = False
'Si el índice es multicampo, se podrían añadir más campos
Set CampoMayorista = IdxMayorista.CreateField("Mayorista")
'El orden del índice va a ser descendente
CampoMayorista.Attributes = dbDescending
IdxMayorista. Fields. Append CampoMayorista
'A continuación se añaden los índices a la tabla
NewTb. Indexes. Append IdxArticulo
NewTb. Indexes. Append IdxMayorista
'Lo último que hay que hacer es incorporar la tabla a la base de datos
NewDb. TableDefs. Append NewTb
'Las tablas y los índices también se pueden crear usando consultas DDL
Dim SQLCreate As String
SQLCreate = "CREATE TABLE Clientes (Cliente LONG, Apellidos TEXT (30), "
SQLCreate = SQLCreate + "Nombre TEXT (30), Direccion TEXT (40), "
SQLCreate = SQLCreate + "Ciudad TEXT (30), Provincia TEXT (2), "
SQLCreate = SQLCreate + "CodigoPostal TEXT (5), Interes MEMO, "
SQLCreate = SQLCreate + "Vendedor TEXT (6))"
NewDb.Execute SQLCreate
SQLCreate = "CREATE TABLE Vendedores (Vendedor TEXT (6), Apellidos TEXT (30)"
SQLCreate = SQLCreate + ", Nombre TEXT (30))"
NewDb.Execute SQLCreate
SQLCreate = "CREATE TABLE Pedidos (Pedido LONG, Cliente LONG, "
SQLCreate = SQLCreate + "Vendedor TEXT (6), FechaPedido DATETIME, "
SQLCreate = SQLCreate + "PrecioTotal SINGLE)"
NewDb.Execute SQLCreate
SQLCreate = "CREATE TABLE Ventas (Pedido LONG, Articulo LONG)"
NewDb.Execute SQLCreate
SQLCreate = "CREATE TABLE Proveedores (Proveedor LONG , Nombre TEXT (50), "
SQLCreate = SQLCreate + "Contacto TEXT (50), Direccion TEXT (50), "
SQLCreate = SQLCreate + "Ciudad TEXT (30), Provincia TEXT (2), "
SQLCreate = SQLCreate + "CodigoPostal TEXT (5), Telefono TEXT (13))"
NewDb.Execute SQLCreate
'Creación de los índices de las tablas"
SQLCreate = "CREATE INDEX NumCliente ON Clientes (Cliente) WITH PRIMARY"
NewDb.Execute SQLCreate
SQLCreate = "CREATE INDEX NumVendedor ON Vendedores (Vendedor) "
SQLCreate = SQLCreate + "WITH PRIMARY"
NewDb.Execute SQLCreate
SQLCreate = "CREATE INDEX NumPedido ON Pedidos (Pedido) WITH PRIMARY"
NewDb.Execute SQLCreate
SQLCreate = "CREATE INDEX NumVenta ON Ventas (Pedido) WITH PRIMARY"
NewDb.Execute SQLCreate
SQLCreate = "CREATE INDEX NumProveedor ON Proveedores (Proveedor) "
SQLCreate = SQLCreate + "WITH PRIMARY"
NewDb.Execute SQLCreate
'Definición de las relaciones entre tablas empleando el objeto relación
Dim NewRel As Relation
Dim CampoRel As Field
'Aquí se crea el objeto relación
Set NewRel = NewDb.CreateRelation("Clientes_Pedidos")
'Se especifican las propiedades de la relación
NewRel.Table = "Clientes"
NewRel.ForeignTable = "Pedidos"
'Crear el campo de relación y establecer las propiedades
Set CampoRel = NewRel.CreateField("Cliente")
CampoRel.ForeignName = "Cliente"
'Agregar el campo a la relación y la relación a la DB
NewRel.Fields.Append CampoRel
NewDb.Relations.Append NewRel
Set NewRel = NewDb.CreateRelation("Proveedores_Articulos")
NewRel.Table = "Proveedores"
NewRel.ForeignTable = "Articulos"
Set CampoRel = NewRel.CreateField("Proveedor")
CampoRel.ForeignName = "Proveedor"
NewRel. Fields. Append CampoRel
NewDb.Relations.Append NewRel
'Se cierra la base de datos y se liberan los recursos
NewDb.Close
MsgBox "Base de datos creada"
'Ahora para trabajar con la tabla debemos abrir la DB y la tabla.
Dim WsAcuario As Workspace
Dim DbAcuario As Database
Dim TbClientes As Recordset
Set WsAcuario = DBEngine.Workspaces(0)
Set DbAcuario = WsAcuario.OpenDatabase(DbPath)
Set TbClientes = DbAcuario.OpenRecordset("Clientes", dbOpenTable)
On Error GoTo Errores
WsAcuario.BeginTrans
TbClientes.AddNew
TbClientes("Cliente") = 1
TbClientes("Apellidos") = "Apellido cliente 1"
TbClientes("Nombre") = "Nombre del cliente 1"
TbClientes("Direccion") = "Direccion cliente 1"
TbClientes("Ciudad") = "Ciudad cliente 1"
TbClientes("Provincia") = "Po"
TbClientes("CodigoPostal") = "36202"
TbClientes("Interes") = "Comentarios sobre el cliente n-mero 1"
TbClientes("Vendedor") = "VEND1"
TbClientes.Update
If MsgBox("+Guardar cambios?", vbQuestion + vbYesNo, "Guardar Cambios") =
vbYes Then
WsAcuario.CommitTrans 'Guardar los cambios
MsgBox ("Datos Guardados")
Else
WsAcuario.Rollback 'No guardar los cambios
MsgBox ("No se han guardado los datos")
End If
DbAcuario.Close
Exit Sub
Errores:
Dim Mensaje As String
Dim Respuesta As Integer
WsAcuario.Rollback
Mensaje = "Error numero " & Str(Err.Number) & " " & Err.Description
Respuesta = MsgBox(Mensaje, vbCritical, "Error al escribir")
Creación de Bases de Datos en RunTime.
'
'Procedimiento para crear una DB y tablas asociadas en runtime
'
Const DbPath As String = "acuario2.mdb"
'Definición de la Base de Datos
Dim NewDb As Database
Dim Ws As Workspace
'Primero se crea un espacio de trabajo
Set Ws = DBEngine.Workspaces(0)
Dim DbOpciones As Long
'la DB será en formato Access 2.0 y estará encriptada
DbOpciones = dbVersion20 + dbEncrypt
'Esto crea la DB
Set NewDb = Ws.CreateDatabase(DbPath, dbLangGeneral, DbOpciones)
'Definición de una tabla
Dim NewTb As TableDef
'Aquí se crea una tabla en el DB
Set NewTb = NewDb.CreateTableDef("Articulos")
'Se establece una normativa en la tabla que es que la cantidad mínima a
'tener debe de ser mayor o igual a 0
NewTb.ValidationRule = "CantidadMinima >= 0"
'Mensaje de error si no se cumple la regla anterior
NewTb.ValidationText = "La cantidad mínima debe ser mayor o igual a 0"
'Definición de los campos de la tabla
'La tabla de artículos va a constar de 7 campos diferentes
ReDim Campo(1 To 9) As Field
'Definición del primer campo de la tabla
Set Campo(1) = NewTb.CreateField("Articulo", dbLong)
'Idem del segundo campo
Set Campo(2) = NewTb.CreateField("Descripcion", dbText, 50)
'Ídem del tercer campo. Las propiedades se establecen de forma explícita,
'en vez de usar los argumentos de CreateField
Set Campo(3) = NewTb.CreateField()
Campo(3).Name = "Categoria"
Campo(3).Type = dbText
Campo(3).Size = 10
Set Campo(4) = NewTb.CreateField("Mayorista", dbSingle)
'Se establecen propiedades de validación del campo
Campo(4).ValidationRule = "[Mayorista]>0"
Campo(4).ValidationText = "El precio de mayorista debe ser mayor que 0"
Set Campo(5) = NewTb.CreateField("Minorista", dbSingle)
Set Campo(6) = NewTb.CreateField("CantidadMinima", dbInteger)
Set Campo(7) = NewTb.CreateField()
Campo(7).Name = "Disponible"
Campo(7).Type = dbInteger
Set Campo(8) = NewTb.CreateField("Proveedor", dbLong)
Set Campo(9) = NewTb.CreateField("Fotografia", dbLongBinary)
'Se añaden los campos a la definición de la tabla
Dim i As Byte
For i = 1 To 9
NewTb.Fields.Append Campo(i)
Next i
'Definición de los índices de la tabla
Dim IdxArticulo As Index, IdxMayorista As Index
Dim CampoArticulo As Field, CampoMayorista As Field
'Primero se crea un índice
Set IdxArticulo = NewTb.CreateIndex("Articulo")
'y se establece que va a ser el índice primario
IdxArticulo.Primary = True
'Se crea un campo que va ser el que forma el índice
Set CampoArticulo = IdxArticulo.CreateField("Articulo")
'y se añade el campo al índice.
IdxArticulo.Fields.Append CampoArticulo
'Se crea otro índice para la tabla
Set IdxMayorista = NewTb.CreateIndex("PrecioPagado")
'y se establece que va no va a ser de tipo único
IdxMayorista.Unique = False
'Si el índice es multicampo, se podrían añadir más campos
Set CampoMayorista = IdxMayorista.CreateField("Mayorista")
'El orden del índice va a ser descendente
CampoMayorista.Attributes = dbDescending
IdxMayorista. Fields. Append CampoMayorista
'A continuación se añaden los índices a la tabla
NewTb. Indexes. Append IdxArticulo
NewTb. Indexes. Append IdxMayorista
'Lo último que hay que hacer es incorporar la tabla a la base de datos
NewDb. TableDefs. Append NewTb
'Las tablas y los índices también se pueden crear usando consultas DDL
Dim SQLCreate As String
SQLCreate = "CREATE TABLE Clientes (Cliente LONG, Apellidos TEXT (30), "
SQLCreate = SQLCreate + "Nombre TEXT (30), Direccion TEXT (40), "
SQLCreate = SQLCreate + "Ciudad TEXT (30), Provincia TEXT (2), "
SQLCreate = SQLCreate + "CodigoPostal TEXT (5), Interes MEMO, "
SQLCreate = SQLCreate + "Vendedor TEXT (6))"
NewDb.Execute SQLCreate
SQLCreate = "CREATE TABLE Vendedores (Vendedor TEXT (6), Apellidos TEXT (30)"
SQLCreate = SQLCreate + ", Nombre TEXT (30))"
NewDb.Execute SQLCreate
SQLCreate = "CREATE TABLE Pedidos (Pedido LONG, Cliente LONG, "
SQLCreate = SQLCreate + "Vendedor TEXT (6), FechaPedido DATETIME, "
SQLCreate = SQLCreate + "PrecioTotal SINGLE)"
NewDb.Execute SQLCreate
SQLCreate = "CREATE TABLE Ventas (Pedido LONG, Articulo LONG)"
NewDb.Execute SQLCreate
SQLCreate = "CREATE TABLE Proveedores (Proveedor LONG , Nombre TEXT (50), "
SQLCreate = SQLCreate + "Contacto TEXT (50), Direccion TEXT (50), "
SQLCreate = SQLCreate + "Ciudad TEXT (30), Provincia TEXT (2), "
SQLCreate = SQLCreate + "CodigoPostal TEXT (5), Telefono TEXT (13))"
NewDb.Execute SQLCreate
'Creación de los índices de las tablas"
SQLCreate = "CREATE INDEX NumCliente ON Clientes (Cliente) WITH PRIMARY"
NewDb.Execute SQLCreate
SQLCreate = "CREATE INDEX NumVendedor ON Vendedores (Vendedor) "
SQLCreate = SQLCreate + "WITH PRIMARY"
NewDb.Execute SQLCreate
SQLCreate = "CREATE INDEX NumPedido ON Pedidos (Pedido) WITH PRIMARY"
NewDb.Execute SQLCreate
SQLCreate = "CREATE INDEX NumVenta ON Ventas (Pedido) WITH PRIMARY"
NewDb.Execute SQLCreate
SQLCreate = "CREATE INDEX NumProveedor ON Proveedores (Proveedor) "
SQLCreate = SQLCreate + "WITH PRIMARY"
NewDb.Execute SQLCreate
'Definición de las relaciones entre tablas empleando el objeto relación
Dim NewRel As Relation
Dim CampoRel As Field
'Aquí se crea el objeto relación
Set NewRel = NewDb.CreateRelation("Clientes_Pedidos")
'Se especifican las propiedades de la relación
NewRel.Table = "Clientes"
NewRel.ForeignTable = "Pedidos"
'Crear el campo de relación y establecer las propiedades
Set CampoRel = NewRel.CreateField("Cliente")
CampoRel.ForeignName = "Cliente"
'Agregar el campo a la relación y la relación a la DB
NewRel.Fields.Append CampoRel
NewDb.Relations.Append NewRel
Set NewRel = NewDb.CreateRelation("Proveedores_Articulos")
NewRel.Table = "Proveedores"
NewRel.ForeignTable = "Articulos"
Set CampoRel = NewRel.CreateField("Proveedor")
CampoRel.ForeignName = "Proveedor"
NewRel. Fields. Append CampoRel
NewDb.Relations.Append NewRel
'Se cierra la base de datos y se liberan los recursos
NewDb.Close
MsgBox "Base de datos creada"
'Ahora para trabajar con la tabla debemos abrir la DB y la tabla.
Dim WsAcuario As Workspace
Dim DbAcuario As Database
Dim TbClientes As Recordset
Set WsAcuario = DBEngine.Workspaces(0)
Set DbAcuario = WsAcuario.OpenDatabase(DbPath)
Set TbClientes = DbAcuario.OpenRecordset("Clientes", dbOpenTable)
On Error GoTo Errores
WsAcuario.BeginTrans
TbClientes.AddNew
TbClientes("Cliente") = 1
TbClientes("Apellidos") = "Apellido cliente 1"
TbClientes("Nombre") = "Nombre del cliente 1"
TbClientes("Direccion") = "Direccion cliente 1"
TbClientes("Ciudad") = "Ciudad cliente 1"
TbClientes("Provincia") = "Po"
TbClientes("CodigoPostal") = "36202"
TbClientes("Interes") = "Comentarios sobre el cliente n-mero 1"
TbClientes("Vendedor") = "VEND1"
TbClientes.Update
If MsgBox("+Guardar cambios?", vbQuestion + vbYesNo, "Guardar Cambios") =
vbYes Then
WsAcuario.CommitTrans 'Guardar los cambios
MsgBox ("Datos Guardados")
Else
WsAcuario.Rollback 'No guardar los cambios
MsgBox ("No se han guardado los datos")
End If
DbAcuario.Close
Exit Sub
Errores:
Dim Mensaje As String
Dim Respuesta As Integer
WsAcuario.Rollback
Mensaje = "Error numero " & Str(Err.Number) & " " & Err.Description
Respuesta = MsgBox(Mensaje, vbCritical, "Error al escribir")
- Compartir respuesta
- Anónimo
ahora mismo