Private Sub cmdExportar_Click()
Dim RstO As DAO.Recordset, RstD As DAO.Recordset 'Definimos las variables para los recordsets
Dim Campo As DAO.Field
On Error GoTo cmdExportar_Click_Err
Set RstO = Me.RecordsetClone 'Cargamos la variable RstO con el clon del recordset del formulario
'así tendremos los registros que se muestran en este momento
Set RstD = CurrentDb.OpenRecordset("Tabla Destino") 'Abrimos la tabla de destino
If RstO.RecordCount > 0 Then RstO.MoveFirst 'Vamos al primer registro
Do Until RstO.EOF 'Repetiremos hasta llegar al final del recordset de origen
RstD.AddNew 'Añadimos un nuevo registro a la tabla de destino
For Each Campo In RstO.Fields 'Para cada campo del origen
If (Campo.Attributes And dbAutoIncrField) = 0 Then 'Si el campo no es autoincrementado
RstD.Fields(Campo.Name) = Campo 'Cargamos el valor del campo al equivalente de la tabla de destino
End If
Next Campo 'Repetimos para cada campo
RstD.Update 'Guardamos los cambios del registro
RstO.MoveNext 'Vamos al siguiente registro del origen
DoEvents
Loop
GoTo cmdExportar_Click_Fin
cmdExportar_Click_Err:
If Err = 3022 Then 'No se puede añadir porque ya existe ese registro
RstD.CancelUpdate 'Cancelamos la actualización y seguimos
Resume Next
ElseIf Err = 3078 Then 'No existe la tabla de destino
MsgBox "No existe la tabla de destino."
RstO.Close
Set RstO = Nothing
Exit Sub
ElseIf Err = 3265 Then
MsgBox "La estructura de la tabla de estino no es válida. No existe el campo '" & Campo.Name & "."
RstD.CancelUpdate
GoTo cmdExportar_Click_Fin
Else
MsgBox "Error " & Err & ": " & Err.Description
End If
cmdExportar_Click_Fin:
'Cerramos los recordsets
RstO.Close
RstD.Close
'Vaciamos las variables de objeto usadas
Set Campo = Nothing
Set RstO = Nothing
Set RstD = Nothing
End Sub
