Ver Mensaje Individual
  #2 (permalink)  
Antiguo 03/03/2005, 08:08
Avatar de vbx3m
vbx3m
 
Fecha de Ingreso: febrero-2005
Ubicación: Venezuela
Mensajes: 524
Antigüedad: 19 años, 2 meses
Puntos: 1
Copiar

Tengo este codigo pero no lo he probado... Si lo quieres utilizar es:

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, etc
On Error Resume Next
`para cada tabla de origen
For Each tdOrigen In dbOrigen.TableDefs
If (tdOrigen.Attributes And (dbSystemObject Or dbHiddenObject)) = 0 Then
`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 añado 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 añado los indices
For Each idOrigen In tdOrigen.Indexes
Set idDestino = tdDestino.CreateIndex(idOrigen.Name)
`añado los campos al índice
For Each fdOrigen In idOrigen.Fields
Set fdDestino = idDestino.CreateField(fdOrigen.Name)
idDestino.Fields.Append fdDestino
Next
`copio las propiedades del índice
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 solicitó
If boCopiarDatos Then dbOrigen.Execute (`INSERT INTO ` + tdDestino.Name + ` IN `` + strDestino + `` SELECT * FROM ` + tdDestino.Name)
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

Pruebalo y me avisas si te sirvio...
__________________
ホルヘ・ラファエル・マルティネス・レオン