Emilio, vete viendo el codigo con calma....
si ves que se te produce algun tipo de error,dimelo
para corregirlo.
Aqui empezamos con posibles funciones y Sub que deberías añadir a la MDB
que mandes para actualizar (Tipo de la que te he enviado por correo personal)
Sub CopiarReportesAccess(RutaDestinoReportes As String, NombreReporte As String)
DoCmd.CopyObject RutaDestinoReportes, NombreReporte, acReport, NombreReporte
Exit Sub
End Sub
Sub CopiarModulos(RutaDestinoModulos As String, NombreModulo As String)
DoCmd.CopyObject RutaDestinoModulos, NombreModulo, acModule, NombreModulo
Exit Sub
End Sub
Sub CopiarTablas(RutaDestinoTablas As String, NombreTabla As String)
DoCmd.CopyObject RutaDestinoTablas, NombreTabla, acTable, NombreTabla
Exit Sub
End Sub
Si te das cuenta el CopyObject puede desarrollar este tipo de copias
Sería conveniente que te leyeras la ayuda de Access para que vieras alguna limitacion
que tiene en el caso de las tablas.
Logicamente todos los objetos, en este caso que te interesa, las tablas, que desees
copiar al modulo de Datos, debes incluirlas en esta MDB de actualizacion que corre el codigo.
Tienes la posibilidad de copiar las tablas tambien mediante una clausula Sql:
Dim BaseOri As Database
Dim NomBaseDes As String
NomBaseDes = "c:\CarpetaDatos\Datos.mdb"
Set BaseOri = CurrentDb
'Copia la tabla Clientes a la base destino de Datos
BaseOri.Execute "SELECT Clientes.* INTO Clientes IN '" & NomBaseDes & "' FROM Clientes;"
BaseOri.Close
Cualquiera de los dos metodos puede ser valido.
No obstante, Emilio, te recuerdo que en concreto con la Clausula SQL menconada anteriormente
no se copian todas las propiedades de la Tabla, o eso por lo menos tengo entendido.
El metodo bueno, para mí, sería el siguiente:
OJO que es muy largo....pero en realidad es el completo
y es bastante intructivo:
===============INICIO DEL CODIGO========================
'Proposito.
'Yo tengo una MDb situada en C:\TwPAc\Datos.mdb
'y deseo incorporar nuevas tablas a dicha MDB. ¿Como lo hago?
'Creo una MDB (Esta donde corre este codigo) e incorporo en esta
'Mdb todas las tablas, datos, relaciones, indices etc que deseo
'Volcar en C:\TwPAc\Datos.mdb
'Esto viene muy bien como modelo de 'actualizacion' de programas.
'Yo tengo un programa que utiliza X tablas y deseo incorporar tablas
'nuevas necesarias para que corra la nueva version del programa.
'Este codigo esta probado y funcionando de forma real en mis
'aplicaciones de ACTUALIZACION de determinados programas.
'BHUO AGOSTO DE 2002
'La llamada a estas funciones se realizan desde un boton de
'comando de un formulario residente en esta base de datos, o sea, la
'misma donde se jecuta este codigo:
'Desde un formulario:
Dim Origen As String
Dim Destino As String
Dim DondeEstamos As CurrentProject
NumerodeTablas = 0
MsgBox "Este puede ser un proceso largo.", vbExclamation + vbOKOnly, "COMENZAR"
Set DondeEstamos = Application.CurrentProject
Origen = DondeEstamos.FullName
' Esto que hemos hecho en las tres líneas anteriores es para
' averiguar donde está la ruta de esta MDB/MDE de actualización
' pues el usuario la ha podido depositar donde quiera
Destino = "C:\TWPAC\DATOS.MDB"
'La anterior linea es la mDB donde queremos copiar las tablas
'incoporadas a esta MDB
DoCmd.Hourglass True
CopiaTablas Origen, Destino
DoCmd.Hourglass False
MsgBox "Proceso de incorporación de nuevas Tablas Concluido." & Chr(13) & _
"Se han incorporado " & NumerodeTablas & " Tablas nuevas a su base de datos", vbInformation + vbOKOnly, "Fin del Proceso."
Option Compare Database
Option Explicit
'***************************************************************
' (C) Francisco García Aguado, Junio de 2002 *
' Utiliza DAO *
'Este módulo es exclusivo para COPIAR TABLAS NUEVAS CON DATOS *
'en el módulo de Servicio. *
'Las nuevas tablas deberán estar grabadas en esta MDB / MDE *
'de actualización *
'***************************************************************
Sub CopiaTablas(strSourceFile As String, strDestFile As String)
Dim dbsSRC As Database, dbsDest As Database
On Error GoTo errExists
Set dbsSRC = DBEngine.Workspaces(0).OpenDatabase(strSourceFile)
Set dbsDest = DBEngine.Workspaces(0).OpenDatabase(strDestFile)
On Error GoTo 0
CopyTables dbsSRC, dbsDest 'Copio tablas y estructura, excepto las del Sistema
CopyQueries dbsSRC, dbsDest 'Copio posibles consultas de Seleccion
CopyData dbsSRC, dbsDest 'Copio Datos, si les hubiera
CopyRelationships dbsSRC, dbsDest 'Copio las relaciones entre estas tablas, si las hubiera
dbsDest.Close
dbsSRC.Close
Exit Sub
errExists:
If Err = 3204 Then
MsgBox "No se ha podido concluir el proceso."
Else
MsgBox "Error: " & Error$, vbCritical + vbOKOnly, "AVISO DE ERROR"
End If
Exit Sub
End Sub
Sub CopyData(dbsSRC As Database, dbsDest As Database)
Dim tbfSrc As TableDef, rstDest As Recordset, rstSrc As Recordset
Dim wspTransact As Workspace
Dim fldSrc As Field
Set wspTransact = DBEngine.Workspaces(0)
wspTransact.BeginTrans
On Error GoTo errRollback
For Each tbfSrc In dbsSRC.TableDefs
If (tbfSrc.Attributes And dbSystemObject) Or _
(tbfSrc.Connect <> "") Then
' Evito copiar Tablas del Sistema
Else
Set rstSrc = dbsSRC.OpenRecordset(tbfSrc.Name, dbOpenTable, _
dbForwardOnly)
If Not rstSrc.EOF Then
Set rstDest = dbsDest.OpenRecordset(tbfSrc.Name, _
dbOpenDynaset, dbAppendOnly)
Do While Not rstSrc.EOF
rstDest.AddNew
For Each fldSrc In rstSrc.Fields
rstDest(fldSrc.Name) = fldSrc.Value
Next
rstDest.Update
rstSrc.MoveNext
Loop
rstDest.Close
End If
rstSrc.Close
End If
Next
wspTransact.CommitTrans
Exit Sub
errRollback:
MsgBox "Error:" & Error$
wspTransact.Rollback
Exit Sub
End Sub
Sub CopyFields(objSrc As Object, objDest As Object)
Dim fldSrc As Field, fldDest As Field
For Each fldSrc In objSrc.Fields
If TypeName(objDest) = "TableDef" Then
Set fldDest = objDest.CreateField(fldSrc.Name, fldSrc.Type, _
fldSrc.Size)
Else
Set fldDest = objDest.CreateField(fldSrc.Name)
End If
CopyProperties fldSrc, fldDest
objDest.Fields.Append fldDest
Next
Exit Sub
End Sub
Sub CopyQueries(dbSrc As Database, dbDest As Database)
Dim qrySrc As QueryDef, qryDest As QueryDef
For Each qrySrc In dbSrc.QueryDefs
Set qryDest = dbDest.CreateQueryDef(qrySrc.Name, qrySrc.Sql)
CopyProperties qrySrc, qryDest
Next
End Sub
Sub CopyRelationships(dbsSRC As Database, dbsDest As Database)
Dim relSrc As Relation, relDest As Relation
For Each relSrc In dbsSRC.Relations
Set relDest = dbsDest.CreateRelation("C" & relSrc.Name, _
relSrc.Table, relSrc.ForeignTable, relSrc.Attributes)
CopyFields relSrc, relDest
dbsDest.Relations.Append relDest
Next
End Sub
Sub CopyTables(dbsSRC As Database, dbsDest As Database)
' Esta rutina ya hace efectiva la incorporacion de las nuevas
' Tablas que acompañan a esta actualizacion, hacia el módulo
' de servicio.
Dim tbfSrc As TableDef, tbfDest As TableDef
Dim IntBuscar As String
On Error GoTo ControlERROR
For Each tbfSrc In dbsSRC.TableDefs
If (tbfSrc.Attributes And dbSystemObject) Then
Else
Set tbfDest = dbsDest.CreateTableDef(tbfSrc.Name, _
tbfSrc.Attributes, tbfSrc.SourceTableName, tbfSrc.Connect)
If tbfSrc.Connect = "" Then
CopyFields tbfSrc, tbfDest
CopyIndexes tbfSrc.Indexes, tbfDest
End If
CopyProperties tbfSrc, tbfDest
NumerodeTablas = NumerodeTablas + 1
dbsDest.TableDefs.Append tbfDest
End If
Next
On Error GoTo 0
Exit Sub
ControlERROR:
MsgBox "La Tabla: " & UCase(tbfSrc.Name) & " ya existe en su Base de Datos." & Chr(13) & _
"Se cancela su copia y se continua con el proceso...", vbInformation + vbOKOnly, "PULSE ACEPTAR PARA CONTINUAR TRABAJANDO"
NumerodeTablas = NumerodeTablas - 1
Resume Next
End Sub
Sub CopyIndexes(idxsSrc As Indexes, objDest As Object)
Dim idxSrc As Index, idxDest As Index, propSrc As Property
For Each idxSrc In idxsSrc
Set idxDest = objDest.CreateIndex(idxSrc.Name)
CopyProperties idxSrc, idxDest
CopyFields idxSrc, idxDest
objDest.Indexes.Append idxDest
Next
End Sub
Sub CopyProperties(objSrc As Object, objDest As Object)
Dim prpProp As Property, temp As Variant
On Error GoTo errCopyProperties
For Each prpProp In objSrc.Properties
objDest.Properties(prpProp.Name) = prpProp.Value
Next
On Error GoTo 0
Exit Sub
errCopyProperties:
Resume Next
End Sub
'************************************************************************************
'************************************************************************************
'En este proceso lo que hemos hecho ha sido copiar las TABLAS
'que acompañan a esta base de Actualización, en el módulo de servicio
'que en el caso del ejemplo es C:\TWPAC\DATOS.MDB
'
'************************************************************************************
'************************************************************************************
Function Errores(NumeroError As Double, Formulario As String)
' ..............
If NumeroError = 2105 Then
MsgBox "Aviso desde el formulario:" & Formulario & Chr(13) _
& "Nº: " & NumeroError & " ->" & "Se ha llegado al Principio / Fin del fichero de Datos", vbInformation + vbOKOnly, "PROGRAMA TALLER MECÁNICO 2000"
Else
MsgBox "Aviso desde el formulario:" & Formulario & Chr(13) _
& "Nº: " & NumeroError & " ->" & Err.Description, vbInformation + vbOKOnly, "PROGRAMA TALLER MECÁNICO 2000"
End If
End Function
=================FIN DE CODIGO========================
En este sentido, Emilio Martinez posteo tambien un codigo similar:
COPIA DEL COIDIGO DE ENRIQUE MARTINEZ
=====================================
=======================
IMPORTAR TABLAS DE ACCESS
=======================
La ayuda muestra cómo crear una nueva tabla en una base de datos «activa» importando los datos desde otra base de datos «externa», mediante el uso de una variación de la instrucción «SELECT». Para ello, sólo nos bastará con añadirle a la consulta de creación de tabla la cláusula «INTO» de SQL. Hay que tener en cuenta que, al crear la tabla, los campos de la nueva tabla sólo heredarán el tipo de datos y el tamaño de los campos de las tablas externas de la consulta, pero no se transferirán ni los índices de la tabla ni cualquier otra propiedad de la misma.
Los ejemplos aquí explicados, van a abrir o establecer conexión con dos bases de datos: BD2.MDB que será la base de datos dónde se importará la tabla (llamada «Base de datos Actual») y BD1.MDB que será la base de datos que contenga la tabla que deseamos importar (llamada «Base de datos Externa»).
Si queréis utilizar los ejemplos, es recomendable que previamente tengáis creadas las bases de datos con estos nombres. Asimismo, en la base de datos externa (bd1.mdb), crear una tabla denominada "Socios" que es la tabla que se va a importar a la otra base de datos. Crear también en dicha tabla, una clave principal y varios índices para que, también éstos, se puedan importar, pero sólo con DAO.
Quiero advertir que para probar los ejemplos he utilizado bases de datos Access 2000 y referencias a Microsoft DAO 3.6 y Microsoft ActiveX Data Object 2.6, aunque también funcionarán con versiones inferiores de dichas bibliotecas de acceso a datos.
Para usuarios de DAO
--------------------
La ventaja que vamos a tener en este ejemplo es que también vamos a importar los índices de la tabla, haciendo un recorrido por la colección «Indexes» de la tabla externa.
Dim dbActual As Database, dbExterna As Database
Dim idxFrom AsIndex, idxTo As Index
Dim sTablaNameExterna As String, sTablaNameActual As String
Dim sConnect As String, sSQL As String
' Abro la base actual
Set dbActual = DBEngine.OpenDatabase(App.Path & "\Bd2.mdb")
' Abro la base externa
Set dbExterna = DBEngine.OpenDatabase(App.Path & "\Bd1.mdb")
sTablaNameActual = "Tabla Importada de Socios"
sTablaNameExterna = "Socios"
' Importamos la tabla
sConnect = "[;DATABASE=" & dbActual.Name & "]."
sSQL = "SELECT * INTO " & sConnect & "[" & sTablaNameActual & "] FROM [" & sTablaNameExterna & "]"
dbExterna.Execute sSQL
dbActual.TableDefs.Refresh
' Importamos los índices
For Each idxFrom In dbExterna.TableDefs(sTablaNameExterna).Indexes
Set idxTo = dbActual.TableDefs(sTablaNameActual).CreateIndex(idxFrom.Name)
With idxTo
' El índice no representa una clave externa
If Not idxFrom.Foreign Then
.Fields = idxFrom.Fields
.Unique = idxFrom.Unique
.Primary = idxFrom.Primary
dbActual.TableDefs(sTablaNameActual).Indexes.Append idxTo
End If
End With
Next
' Cerramos las bases de datos
dbActual.Close
dbExterna.Close
Para usuarios de ADO
--------------------
A diferencia del anterior, en este ejemplo sólo vamos a importar los datos de la tabla externa.
Dim cnnActual As New ADODB.Connection
Dim cnnExterna As New ADODB.Connection
Dim sTablaNameExterna As String, sTablaNameActual As String
Dim sConnect As String, sSQL As String
' Establezco la conexión con la base de datos actual
With cnnActual
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & App.Path & "\bd2.mdb;"
.Open
End With
' Establezco la conexión con la base de datos externa
With cnnExterna
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & App.Path & "\bd1.mdb;"
.Open
End With
sTablaNameActual = "Tabla Importada de Socios"
sTablaNameExterna = "Socios"
' Importamos la tabla
sConnect = "[;DATABASE=" & cnnActual.Properties("Data Source") & "]."
sSQL = "SELECT * INTO " & sConnect & "[" & sTablaNameActual & "] FROM [" & sTablaNameExterna & "]"
cnnExterna.Execute sSQL
' Cerramos las conexiones
cnnActual.Close
cnnExterna.Close
--
Enrique Martínez («Sofjaen»)
Enero, 2002
FIN DE CODIGO DE ENRIQUE MARTINEZ
*************************************************
*************************************************
Ahora, Emilio, como incorporar campos a alguna tabla ya existente del modulo de datos:
--------------------------------------------------------------------------------------
**************************************************************************************
Option Compare Database
Option Explicit
'***************************************************************
' (C) Francisco García Aguado, Junio de 2000 *
' Utiliza DAO *
'Este módulo es exclusivo para Modificar Tablas del módulo de *
'Servicio con la incorporaciónde nuevos campos. *
'***************************************************************
Function CrearNuevoCampo(Ruta As String, NombreTabla As String, NombreCampo As String, TipoCampo As Integer, NombreIndice As String, TipoIndice As Boolean)
On Error GoTo Err_Comando0_Click
'Esta función añade campos a las tablas ya existentes de base de datos de Servicio
'Recibe como parametros:
'Ruta: Ruta y nombre completo de la MDB de servicio a tratar
'NombreTabla: Tabla a modificar
'NombreCampo: Nombre del campo a añadir
'NombreIndice: Nombre del indice, si el campo está indexado
'TipoIndice: Si está con o sin duplicados.
'TipoCampo: Tipo del campo, según las constantes de Access.
' A Y U D A D E C O N S T A N T E S T I P O / C A M P O === I N T E G E R
'dbBinary=9
'dbBoolean=1
'dbByte =2
'dbChar =18
'dbCurrency=5
'dbDate Date / Time=8
'dbDecimal Decimal=20
'dbDouble Double=7
'dbFloat Float=21
'dbInteger Integer=3
'dbLong Long=4
'dbLongBinary Long Binary (Objeto OLE)=11
'dbMemo Memo=12
'dbNumeric Numeric19
'dbSingle Single=6
'dbText Text=10
'dbTime Time=22
Dim Base As Database
Dim tdfTabla As TableDef
Dim fldCampo As Field
Dim NewIdx As Index
' abro la base de servicio donde tenga los datos
Set Base = OpenDatabase(Ruta)
' abro el objeto Tabla al cual voy añadir campos
Set tdfTabla = Base(NombreTabla)
' evito una doble actualización:
For Each fldCampo In Base.TableDefs(NombreTabla).Fields
If UCase(fldCampo.Name) = UCase(NombreCampo) Then
MsgBox "La tabla de datos " & tdfTabla.Name & " ya está actualizada en el campo: " & UCase(fldCampo.Name), vbInformation + vbOKOnly, "Tabla ya actualizada en Programa."
Exit Function
End If
Next
' Creo y agrego el objeto Campo nuevo
With tdfTabla
.Fields.Append .CreateField(NombreCampo, TipoCampo)
End With
' Creo y agrego los indices, si es que se pasan como parametros NO NULOS
' para lo cual, lo compruebo viendo si se ha recibido el parametro como ""
If Len(NombreIndice) <> 0 Then
Set NewIdx = tdfTabla.CreateIndex(NombreIndice)
NewIdx.Unique = TipoIndice
Set fldCampo = NewIdx.CreateField(NombreCampo)
NewIdx.Fields.Append fldCampo
tdfTabla.Indexes.Append NewIdx
End If
Base.Close
Set Base = Nothing ' libero
Exit_Comando0_Click:
Exit Function
Err_Comando0_Click:
' Ojo si hay algún usuario
' conectado a la base de servicio,el propio sistema de detección de errores
' avisa de esta contigencia en esta actualización, con mensaje personalizado.
If Err.Number = 3262 Then
MsgBox "No se puede actualizar la tabla pues está en uso en algún " & Chr(13) & _
"puesto de trabajo. Cierre todas las aplicaciones del programa." _
, vbCritical + vbOKOnly, "A V I S O A C T U A L I Z A C I O N"
Resume Exit_Comando0_Click
Exit Function
End If
MsgBox Err.Description
Resume Exit_Comando0_Click
End Function
Y si juntas todo esto, lo metes en una MDB, etc etc, te pude quedar un buen
modulo de actualizacion de datos.
Mas o menos esta la idea.
Un Abrazo
Paco
(
geocities.com/es/ensolva/Descargas) (
geocities.com/es/ensolva) (
geocities.com/es)