Copiar tablas de una base a otra
He sacado de internet un código para copiar las tablas de una base de datos en otra, y me seria útil para hacer una copia de seguridad, a ver si me puedes ayudar. Tengo access 2000 y cuando pongo el código me salen varios errores.
Te mando el código por si lo quieres mirar:
---Esta rutina sirve para copiar todas las tablas de una base de datos en una destino.
'Si las tablas ya existian en la base de datos de eliminan y se vuelven a crear con
'la misma estructura que tuvieran en origen
'Las tablas de la base destino que no se encuentren en origen no se modifican.
'Si el parametro boCopiarDatos es true (valor por defecto) ademas de
'estructura se copian los datos de las tablas.
Sub CopiaTablas(strOrigen As String, strDestino As String, Optional boCopiarDatos As Boolean = True)
Dim dbOrigen As Database, dbDestino As Database
Dim tdOrigen As TableDef, tdDestino As TableDef
Dim fdOrigen As Field, fdDestino As Field
Dim idOrigen As Index, idDestino As Index
Dim prOrigen As Property, prDestino As Properties
Dim i As Long
Screen.MousePointer = vbHourglass
'---abrir origen y destino
Set dbOrigen = OpenDatabase(strOrigen, False)
Set dbDestino = OpenDatabase(strDestino, True)
'---hay propiedades que no se pueden copiar como el value de los campos
On Error Resume Next
'---para cada tabla de origen
For Each tdOrigen In dbOrigen.TableDefs
If (tdOrigen.Attributes And (dbSystemObject Or dbHiddenObject))
'---si la tabla no es del sistema
'---mirar si existe la tabla en destino
For Each tdDestino In dbDestino.TableDefs
If tdDestino.Name = tdOrigen.Name Then
'---si existe la borro
dbDestino.TableDefs.Delete tdDestino.Name
Exit For
End If
Next
'---creo la tabla en el destino
Set tdDestino = dbDestino.CreateTableDef(tdOrigen.Name, _
tdOrigen.Attributes, tdOrigen.SourceTableName, tdOrigen.Connect)
'---le anado los campos
For Each fdOrigen In tdOrigen.Fields
Set fdDestino = tdDestino.CreateField(fdOrigen.Name, _
fdOrigen.Type, fdOrigen.Size)
'---copio las propiedades del campo
For Each prOrigen In fdOrigen.Properties
fdDestino.Properties(prOrigen.Name) =_
fdOrigen.Properties(prOrigen.Name)
Next
tdDestino.Fields.Append fdDestino
Next
'---le anado los indices
For Each idOrigen In tdOrigen.Indexes
Set idDestino = tdDestino.CreateIndex(idOrigen.Name)
'---anado los campos al indice
For Each fdOrigen In idOrigen.Fields
Set fdDestino = idDestino.CreateField(fdOrigen.Name
idDestino.Fields.Append fdDestino
Next
'---copio las propiedades del indice
For Each prOrigen In idDestino.Properties
idDestino.Properties(prOrigen.Name) =
idOrigen.Properties(prOrigen.Name)
Next
tdDestino.Indexes.Append idDestino
Next
dbDestino.TableDefs.Append tdDestino
'---copio los datos de la tabla, si se solicito
If boCopiarDatos Then dbOrigen.Execute ("INSERT INTO " + _
tdDestino.Name + " IN '" + strDestino + "' SELECT * FROM " + tdDesti
End If
Next
'---cerrar origen y destino
dbOrigen.Close
dbDestino.Close
Set dbOrigen = Nothing: Set dbDestino = Nothing
Set tdOrigen = Nothing: Set tdDestino = Nothing
Set fdOrigen = Nothing: Set fdDestino = Nothing
Set idOrigen = Nothing: Set idDestino = Nothing
Set prOrigen = Nothing: Set prDestino = Nothing
Screen.MousePointer = vbDefault
End Sub
Te mando el código por si lo quieres mirar:
---Esta rutina sirve para copiar todas las tablas de una base de datos en una destino.
'Si las tablas ya existian en la base de datos de eliminan y se vuelven a crear con
'la misma estructura que tuvieran en origen
'Las tablas de la base destino que no se encuentren en origen no se modifican.
'Si el parametro boCopiarDatos es true (valor por defecto) ademas de
'estructura se copian los datos de las tablas.
Sub CopiaTablas(strOrigen As String, strDestino As String, Optional boCopiarDatos As Boolean = True)
Dim dbOrigen As Database, dbDestino As Database
Dim tdOrigen As TableDef, tdDestino As TableDef
Dim fdOrigen As Field, fdDestino As Field
Dim idOrigen As Index, idDestino As Index
Dim prOrigen As Property, prDestino As Properties
Dim i As Long
Screen.MousePointer = vbHourglass
'---abrir origen y destino
Set dbOrigen = OpenDatabase(strOrigen, False)
Set dbDestino = OpenDatabase(strDestino, True)
'---hay propiedades que no se pueden copiar como el value de los campos
On Error Resume Next
'---para cada tabla de origen
For Each tdOrigen In dbOrigen.TableDefs
If (tdOrigen.Attributes And (dbSystemObject Or dbHiddenObject))
'---si la tabla no es del sistema
'---mirar si existe la tabla en destino
For Each tdDestino In dbDestino.TableDefs
If tdDestino.Name = tdOrigen.Name Then
'---si existe la borro
dbDestino.TableDefs.Delete tdDestino.Name
Exit For
End If
Next
'---creo la tabla en el destino
Set tdDestino = dbDestino.CreateTableDef(tdOrigen.Name, _
tdOrigen.Attributes, tdOrigen.SourceTableName, tdOrigen.Connect)
'---le anado los campos
For Each fdOrigen In tdOrigen.Fields
Set fdDestino = tdDestino.CreateField(fdOrigen.Name, _
fdOrigen.Type, fdOrigen.Size)
'---copio las propiedades del campo
For Each prOrigen In fdOrigen.Properties
fdDestino.Properties(prOrigen.Name) =_
fdOrigen.Properties(prOrigen.Name)
Next
tdDestino.Fields.Append fdDestino
Next
'---le anado los indices
For Each idOrigen In tdOrigen.Indexes
Set idDestino = tdDestino.CreateIndex(idOrigen.Name)
'---anado los campos al indice
For Each fdOrigen In idOrigen.Fields
Set fdDestino = idDestino.CreateField(fdOrigen.Name
idDestino.Fields.Append fdDestino
Next
'---copio las propiedades del indice
For Each prOrigen In idDestino.Properties
idDestino.Properties(prOrigen.Name) =
idOrigen.Properties(prOrigen.Name)
Next
tdDestino.Indexes.Append idDestino
Next
dbDestino.TableDefs.Append tdDestino
'---copio los datos de la tabla, si se solicito
If boCopiarDatos Then dbOrigen.Execute ("INSERT INTO " + _
tdDestino.Name + " IN '" + strDestino + "' SELECT * FROM " + tdDesti
End If
Next
'---cerrar origen y destino
dbOrigen.Close
dbDestino.Close
Set dbOrigen = Nothing: Set dbDestino = Nothing
Set tdOrigen = Nothing: Set tdDestino = Nothing
Set fdOrigen = Nothing: Set fdDestino = Nothing
Set idOrigen = Nothing: Set idDestino = Nothing
Set prOrigen = Nothing: Set prDestino = Nothing
Screen.MousePointer = vbDefault
End Sub
1 Respuesta
Respuesta de raulmoscardo
2