La mejor forma de compartir trabajo ¿Réplicas?

Tengo una base de datos en Access. La tabla principal tiene un Id autonumérico para relacionarla con una segunda tabla que tiene un Id2 autonumérico para relacionarla con una tercera.
Padres(Id)->Hijos(id, Id2)->(Id2)Actividades
Necesito que varios compañeros me ayuden a meter datos, cada uno en su casa sin red de por medio.
En principio creé una réplica para hacer pruebas, pero el Id de salía con un número negativo muy alto (-145666 por poner un ejemplo) en vez de salir con positivos.
Es Id lo uso como número de socio. Y los negativos no me valen ¿hay forma de solucionarlo, de decirle a cada réplica a partir de que Id autonumérico empiece a incrementar (es decir, que la réplica 1 empiece en el 100, la 2 en el 200 etc.)?
Y si no puedo hacer nada de eso, nada, creo un campo número de socio y lo relleno después a mano.
¿Pero hay otra forma mejor de hacerlo?
1

1 respuesta

Respuesta
1
Lo que yo haría es crear copias de la base de datos para que tus compañeros graben la información. Me da lo mismo si generan el id-1 o el 547.
Una vez que tuviera las 17 bases de datos, haría un proceso que leería los datos de cada una de ellas e iría insertando los registros en la mía (la buena).
Está claro que durante la inserción de los datos me va a generar unos 'id' diferentes que habrá que controlar, pero eso no es demasiado complicado haciéndolo por programa.
Te he preparado el siguiente código para que lo uses si eliges hacer muchas bases de datos y después unificarlas:
Option Compare Database
Option Explicit
Global matBases(1 To 200) As String ' Hasta 200 bases de datos de copias
Global nBases As Integer
Sub copiarDatosDeLasBasesDeCopias()
    Dim i As Integer
    leerBasesDeDatosCopias ' Leemos las copias de la subcarpeta
    For i = 1 To nBases
        importarDatosTablas matBases(i)
    Next i
    MsgBox "Proceso terminado"
End Sub
Private Sub leerBasesDeDatosCopias()
    Dim path As String
    Dim d As String
    ' Buscaremos las bases de datos en una subcarpeta 'copias' que cuelga de la
' carpeta de mi base de datos (donde tengo este código)
    path = CurrentProject.path & "\copias\"
    On Error Resume Next
    d = Dir$(path & "*.mdb", vbArchive)
    If Err <> 0 Then
        MsgBox "Error: o no hay ninguna base de datos de copias o la subcarpeta 'copias' no existe"
        d = ""
    End If
    On Error GoTo 0
    nBases = 0
    Do While d <> ""
        nBases = nBases + 1
        matBases(nBases) = path & d
        d = Dir$
    Loop
End Sub
Private Sub importarDatosTablas(ByVal nomBd As String)
    Dim bd As Database      ' Para la base de datos a copiar
    Dim rs As Recordset     ' Para la tabla a copiar
    Dim rsP As Recordset    ' Para la tabla final
    Dim id As Long
    Dim i As Integer
    ' Este procedimiento va a copiar la tabla de Padres y llama a las copias
' de los hijos y esta a la de actividades.
    Set bd = OpenDatabase(nomBd, False, True)
    Set rs = bd.OpenRecordset("Padres")
    Set rsP = CurrentDb().OpenRecordset("Padres")
    If Not rs.EOF Then rs.MoveFirst
    Do While Not rs.EOF
        ' Copiamos el registro menos el campo ID que lo guardamos
        rsP.AddNew
        For i = 0 To rs.Fields.Count - 1
            If UCase$(rs.Fields(i).Name) = "ID" Then
                id = rs!id
              Else
                rsP.Fields(i) = rs.Fields(i)
            End If
        Next i
        rsP.Update
        ' Insertamos los registros de Hijos cambiando el ID anterior (rs! Id) por el nuevo
copiaDatosRegistrosHijos bd, rs! Id, id
rs. MoveNext
    Loop
    rs.Close
    rsP.Close
    bd.Close
End Sub
Private Sub copiaDatosRegistrosHijos(ByRef bd As Database, ByVal idAnt As Long, ByVal idNew As Long)
    Dim rs As Recordset
    Dim rsH As Recordset
    Dim txt As String
    Dim i As Integer
    Dim id2 As Long
    txt = "select * from hijos where id=" & idAnt
    Set rs = bd.OpenRecordset(txt)
    Set rsH = CurrentDb().OpenRecordset("hijos")
    If Not rs.EOF Then rs.MoveFirst
    Do While Not rs.EOF
        rsH.AddNew
        For i = 0 To rs.Fields.Count - 1
            Select Case UCase$(rs.Fields(i).Name)
                Case "ID": rsH!id = idNew ' Ponemos el ID generado antes
                Case "ID2": id2 = rsH!id2 ' Guardamos el nuevo ID2
                Case Else: rsH.Fields(i) = rs.Fields(i)
            End Select
        Next i
        rsH.Update
        ' Llamamos para que se copien las actividades del anterior (rs!id2) al nuevo (id2)
        copiaDatosRegistrosActividades bd, rs!id2, id2
        rs.MoveNext
    Loop
    rs.Close
    rsH.Close
End Sub
Private Sub copiaDatosRegistrosActividades(ByRef bd As Database, ByVal id2Ant As Long, ByVal id2New As Long)
    Dim rs As Recordset
    Dim rsA As Recordset
    Dim txt As String
    Dim i As Integer
    txt = "select * from actividaddes where id2=" & id2Ant
    Set rs = bd.OpenRecordset(txt)
    Set rsA = CurrentDb().OpenRecordset("actividades")
    If Not rs.EOF Then rs.MoveFirst
    Do While Not rs.EOF
        rsA.AddNew
        For i = 0 To rs.Fields.Count - 1
            If UCase$(rs.Fields(i).Name) = "ID2" Then
                rsA!id2 = id2New ' Ponemos el ID2 generado antes
              Else
                rsA.Fields(i) = rs.Fields(i)
            End If
        Next i
        rsA.Update
        rs.MoveNext
    Loop
    Rs. Close
    RsA. Close
End Sub
He creado un módulo, llamado Importar, y una macro con
AbrirModulo -> Importar
Ejecutarcodigo;
Al ejecutarlo me da error en la línea Set rs
txt = "select * from actividaddes where id2=" & id2Ant
-> Set rs = bd.OpenRecordset(txt)
¿Aquí da igual si en mi base id2 se llama Id2 o si tu pones como nombre de la tabla "hijos" y yo la llamo "Hijos"?
Me carga el primer padre de la copia y le asigna un nuevo Id correctamente, pero me carga el primer hijo de ese padre y le asigna el Id "1" que corresponde al primer padre de la original y se detiene.
Es decir
Base original:
- Padres:
Id: 1 Nombre: Padre1
<span style="white-space: pre;"> </span>- Hijo1 (y sus actividades)
<span style="white-space: pre;"> </span>- Hijo2 (y sus actividades)
Base Copia
Id: 1 Nombre: Padre2
<span style="white-space: pre;"> </span>-Hijo3 (y sus actividades
Y al importar queda así:
- Padres:
Id: 1 Nombre: Padre1
<span style="white-space: pre;"> </span>- Hijo1 (y sus actividades)
<span style="white-space: pre;"> </span>- Hijo2 (y sus actividades)
<span style="white-space: pre;"> </span>- Hijo3
Id: 2 Nombre: Padre2
Además tengo otro subformulario con una tabla Socio también asociada al Id de Padres
Así:
http://s299204700.mialojamiento.es/tablas.jpg
Se me había escapado el dedo. Ponía 'actividaddes'.
El código (probado) con las cuatro tablas sería:
Option Compare Database
Option Explicit
Global matBases(1 To 200) As String ' Hasta 200 bases de datos de copias
Global nBases As Integer
Sub copiarDatosDeLasBasesDeCopias()
    Dim i As Integer
    leerBasesDeDatosCopias ' Leemos las copias de la subcarpeta
    For i = 1 To nBases
        importarDatosTablas matBases(i)
    Next i
    MsgBox "Proceso terminado"
End Sub
Private Sub leerBasesDeDatosCopias()
    Dim path As String
    Dim d As String
    ' Buscaremos las bases de datos en una subcarpeta 'copias' que cuelga de la
' carpeta de mi base de datos (donde tengo este código)
    path = CurrentProject.path & "\copias\"
    On Error Resume Next
    d = Dir$(path & "*.mdb", vbArchive)
    If Err <> 0 Then
        MsgBox "Error: o no hay ninguna base de datos de copias o la subcarpeta 'copias' no existe"
        d = ""
    End If
    On Error GoTo 0
    nBases = 0
    Do While d <> ""
        nBases = nBases + 1
        matBases(nBases) = path & d
        d = Dir$
    Loop
End Sub
Private Sub importarDatosTablas(ByVal nomBd As String)
    Dim bd As Database      ' Para la base de datos a copiar
    Dim rs As Recordset     ' Para la tabla a copiar
    Dim rsP As Recordset    ' Para la tabla final
    Dim id As Long
    Dim i As Integer
    ' Este procedimiento va a copiar la tabla de Padres y llama a las copias
' de los hijos y esta a la de actividades.
    Set bd = OpenDatabase(nomBd, False, True)
    Set rs = bd.OpenRecordset("Padres")
    Set rsP = CurrentDb().OpenRecordset("Padres")
    If Not rs.EOF Then rs.MoveFirst
    Do While Not rs.EOF
        ' Copiamos el registro menos el campo ID que lo guardamos
        rsP.AddNew
        For i = 0 To rs.Fields.Count - 1
            If UCase$(rs.Fields(i).Name) = "ID" Then
                id = rsP!id
              Else
                rsP.Fields(i) = rs.Fields(i)
            End If
        Next i
        rsP.Update
        ' Insertamos los registros de Hijos cambiando el ID anterior (rs! Id) por el nuevo
copiaDatosRegistrosHijos bd, rs! Id, id
copiaDatosRegistrosSocios bd, rs! Id, id
rs. MoveNext
    Loop
    rs.Close
    rsP.Close
    bd.Close
End Sub
Private Sub copiaDatosRegistrosHijos(ByRef bd As Database, ByVal idAnt As Long, ByVal idNew As Long)
    Dim rs As Recordset
    Dim rsH As Recordset
    Dim txt As String
    Dim i As Integer
    Dim id2 As Long
    txt = "select * from hijos where id=" & idAnt
    Set rs = bd.OpenRecordset(txt)
    Set rsH = CurrentDb().OpenRecordset("hijos")
    If Not rs.EOF Then rs.MoveFirst
    Do While Not rs.EOF
        rsH.AddNew
        For i = 0 To rs.Fields.Count - 1
            Select Case UCase$(rs.Fields(i).Name)
                Case "ID": rsH!id = idNew ' Ponemos el ID generado antes
                Case "ID2": id2 = rsH!id2 ' Guardamos el nuevo ID2
                Case Else: rsH.Fields(i) = rs.Fields(i)
            End Select
        Next i
        rsH.Update
        ' Llamamos para que se copien las actividades del anterior (rs!id2) al nuevo (id2)
        copiaDatosRegistrosActividades bd, rs!id2, id2
        rs.MoveNext
    Loop
    rs.Close
    rsH.Close
End Sub
Private Sub copiaDatosRegistrosSocios(ByRef bd As Database, ByVal idAnt As Long, ByVal idNew As Long)
    Dim rs As Recordset
    Dim rsS As Recordset
    Dim txt As String
    Dim i As Integer
    txt = "select * from socios where id=" & idAnt
    Set rs = bd.OpenRecordset(txt)
    Set rsS = CurrentDb().OpenRecordset("socios")
    If Not rs.EOF Then rs.MoveFirst
    Do While Not rs.EOF
        rsS.AddNew
        For i = 0 To rs.Fields.Count - 1
            If UCase$(rs.Fields(i).Name) = "ID" Then
                rsS!id = idNew ' Ponemos el ID generado antes
              Else
                rsS.Fields(i) = rs.Fields(i)
            End If
        Next i
        rsS.Update
        rs.MoveNext
    Loop
    rs.Close
    rsS.Close
End Sub
Private Sub copiaDatosRegistrosActividades(ByRef bd As Database, ByVal id2Ant As Long, ByVal id2New As Long)
    Dim rs As Recordset
    Dim rsA As Recordset
    Dim txt As String
    Dim i As Integer
    txt = "select * from actividades where id2=" & id2Ant
    Set rs = bd.OpenRecordset(txt)
    Set rsA = CurrentDb().OpenRecordset("actividades")
    If Not rs.EOF Then rs.MoveFirst
    Do While Not rs.EOF
        rsA.AddNew
        For i = 0 To rs.Fields.Count - 1
            If UCase$(rs.Fields(i).Name) = "ID2" Then
                rsA!id2 = id2New ' Ponemos el ID2 generado antes
              Else
                rsA.Fields(i) = rs.Fields(i)
            End If
        Next i
        rsA.Update
        rs.MoveNext
    Loop
    Rs. Close
    RsA. Close
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas