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 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

Comparación de menor mayor en recordset no funciona

Hago un recorset y busco que un numero dado (puesto en la variable numero) se encuentre o no en un rango de números del recordset... El tema es que cuando ejecuto el código, me dice que el numero esta incluido en rangos donde no debería estarlo. Algo...
2 respuestas

Exportar base de datos access a excel

Quisiera ver si me pueden ayudar por favor. Estoy haciendo una base de datos en access con visual basic pero tengo una duda enorme, quisiera saber si puedo exportar esa base de datos a excel.
1 respuesta

Texto delimitado en un informe de Access

Desarrollé una aplicación en access "Punto de venta e Inventarios" solo estoy atorado en dos cosas, sé que no se puede por medio de access delimitar un informe, en las tabla y consultas solamente se puede, pero en un informe solo con código VB....
1 respuesta

Código para delimitar texto de informa access 2003

Quien me podría ayudar con un código. Les explicaré... Tengo un informe en access el cual quiero exportar a texto delimitado. Separado por (|). Esto es para que un proveedor de facturación electrónica pueda procesarlo, y me piden que sea texto...
1 respuesta

Macros excel con bd sql

Me gustaría saber si me puedes ayudar con una consulta desde una macro en excel necesito consultar y borrar un periodo de una tabla el código he realizado es el siguiente pero parece que no se ejecutara el query sql = "" sql = sql & "select * from...
1 respuesta

Error 2147217900(80040e14) VB

Estoy tratando de conectar una tabla de access (Base de datos) en Tabla de excel (cálculo financiero) con VB, pero al momento de ejecutar me marca error Error 2147217900(80040e14) error de sintaxis en la cláusula from, de favor me puedes ayudar a...
1 respuesta

Cargar txt a access desde vba

Hace un par de meses empecé a usar access para manejar una BD y de a poco fui aprendiendo SQL y algo de VBA. Mi problema es el siguiente quiero automatizar la carga de datos (la BD es de un sistema de cobranzas) el banco realiza los cobros de los...
1 respuesta

Problema con MSHFlexGrid

Tengo una aplicación con un form de consulta de xtabla la cual muestro en una rejilla, utilizo un campo text para filtrar datos mientras escribo, hasta allí todo OK pero si la consulta me devuelve cero registros y luego quito el filtro y quiero...
1 respuesta

ACCESS. ¿Cómo actualizar un campo sin borrarlo?

Por ejemplo, si tenemos una tabla Clientes y otra Pedidos, quiero actualizar un campo de Clientes con sus pedidos pero sin machacar el dato anterior. Si el cliente ha pedido Peras, manzanas y plátanos, quiero que en el campo de Clientes aparezcan...
1 respuesta

Vb6 select (campo) from (variable)

Muy bien mi problema es que intento hacer referencia a una tabla mediante una variable, ya que de eso consta básicamente la aplicación, muy bien le pego mi código y espero me puedan ayudar Option Explicit Dim cnn As New ADODB.Connection Dim rs As New...
1 respuesta