¿Como puedo duplicar registros secuencialmente?

Tengo una base de datos en la que necesito, una vez pasado un registro duplicarlo un númro determindado de veces, pero cambiando en cada una de ellas el valor de un campo que es numérico

Respuesta
1

Hay varias maneras de hacerlo. Te comento una de ellas.

Crea un formulario independiente para insertar el registro, es decir, que tenga los campos que necesites pero sin estar basado en tablas o consultas. En el ejemplo de código que acabo de escribir (espero no tenga errores aunque no lo he probado) se supone existen un campo de texto y un campo numérico en la tabla de destino y en el formulario. Incluyo también en el formulario un campo para indicar el número de registros a insertar y el valor incial a usar en el primer registro que inserte. El código adjudicará un valor incremental en una unidad en cada registro insertado. Obviamente puedes cambiarlo por otros incrementos o lo que quiera que necesites.

El botón insertar comprueba que haya valores en todos los campos y que los númericos lo sean realmente. Tras ello un bucle insertará el número de registros indicado. En el campo CampoTexto siempre insertará el mismo valor que hayas definido, y en el campo CampoNumerico comenzará insertando el valor inicial indicado y le irá sumando una unidad en los sucesivos registros que inserte.

Otras opciones incluyen usar recorsets en código para controlar la inserción de registros. La mecánica sería similar. Todo depende de lo que te sea más cómodo de escribir...

Cordiales saludos.

Option Compare Database 
Option Explicit 
Private Sub Insertar_Click() 
On Error GoTo Err_Insertar_Click 
    Dim msg As String, estilo, title As String 
    estilo = vbCritical + vbOKOnly 
    title = "Error en la inserción por falta de datos" 
    msg = "No se han podido crear los registros solicitados por no existir ninguna entrada válida en el campo " 
    If IsNull(Me.Texto1) Then 
        msg = msg & "Texto1." 
        MsgBox msg, estilo, title 
        Me.Texto1.SetFocus 
        Exit Sub 
    End If 
    If IsNull(Me.Valor1) Then 
        msg = msg & "Valor1." 
        MsgBox msg, estilo, title 
        Me.Valor1.SetFocus 
        Exit Sub 
    End If 
    If Not IsNumeric(Me.Valor1) Then 
        msg = msg & "Valor1." 
        MsgBox msg, estilo, title 
        Me.Valor1.SetFocus 
        Exit Sub 
    End If 
    If IsNull(Me.NumeroRegistros) Then 
        msg = msg & "NumeroRegistros." 
        MsgBox msg, estilo, title 
        Me.NumeroRegistros.SetFocus 
        Exit Sub 
    End If 
    If Not IsNumeric(Me.NumeroRegistros) Then 
        msg = msg & "NumeroRegistros." 
        MsgBox msg, estilo, title 
        Me.NumeroRegistros.SetFocus 
        Exit Sub 
    End If 
    If IsNull(Me.ValorInicial) Then 
        msg = msg & "ValorInicial." 
        MsgBox msg, estilo, title 
        Me.ValorInicial.SetFocus 
        Exit Sub 
    End If 
    If Not IsNumeric(Me.ValorInicial) Then 
        msg = msg & "ValorInicial." 
        MsgBox msg, estilo, title 
        Me.ValorInicial.SetFocus 
        Exit Sub 
    End If 
    Dim miSQL As String, miTexto1 As String, cuantosRegistros As Integer, miValorInicial As Integer, miContador As Integer 
    miTexto1 = Me.Texto1 
    cuantosRegistros = Me.NumeroRegistros 
    miValorInicial = Me.ValorInicial 
    miContador = 1 
    DoCmd.SetWarnings False 
    Do Until miContador = cuantosRegistros 
        miSQL = "INSERT INTO MITABLA (CampoTexto, CampoNumerico) SELECT '" & miTexto1 
        miSQL = miSQL & "', " 
        miSQL = miSQL & miValorInicial & ";" 
        DoCmd.RunSQL miSQL 
        miValorInicial = miValorInicial + 1 
        miContador = miContador + 1 
    Loop 
    DoCmd.SetWarnings True 
    estilo = vbOKOnly + vbInformation 
    title = "Registros creados correctamente" 
    msg = "Se han creado correctamente " & cuantosRegistros & " registros en la tabla MITABLA." 
    MsgBox msg, estilo, title 
Exit_Insertar_Click: 
    Exit Sub 
Err_Insertar_Click: 
    DoCmd.SetWarnings True 
    MsgBox Err.Description 
    Resume Exit_Insertar_Click 
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas