Ejemplares fantasma en Abies 2.x

En la biblioteca de mi instituto usamos todavía el viejo Abies2, pues con nuestra inestable conexión a internet no nos atrevemos a usar abies3. Uno de los problemas que nos ha surgido es que hay unos cuantos ejemplares que han sido catalogados en el pasado (prueba de ello es su código de barras de Abies) pero no aparecen en el catálogo por ninguna parte.

Analizando el problema a partir de una copia de seguridad que abrimos con Access, se manifiesta el origen del problema:

Abies guarda los autores en dos lugares diferentes. En primer lugar está el autor principal, que se almacena en el campo idAutor de la tabla [Fondos]. Por otro lado, en la tabla [Fondos_Autores] hay un registro que lista los autores secundarios y principales de cada fondo, con un campo llamado booleano "principal" que indica si estamos hablando del autor principal o no.

El problema es que al hacer el listado de ejemplares que sale en la pantalla principal de abies, los ejemplares se recuperan a partir de una consulta que solo toma aquellos ejemplares con valores definidos en la tabla [fondos_autores], es decir, que si por la razón que sea (probablemente una edición manual o una actualización mal hecha) se pierden los registros de la tabla [fondos_autores], los fondos desaparecerán de la vista de catálogo.

Podemos añadir la siguiente macro a una copia de seguridad de abies para averiguar qué ejemplares son los que se han convertido en "fantasmas". Aunque he añadido una funcionalidad de "reparación", yo no cambiaría nada a menos que me asegure de que no he vuelto a catalogar los ejemplares desaparecidos... (y teniendo en cuenta que es un proceso largo y que en medio hay que evitar prestar o catalogar ningún fondo, es complicado).

'Buscar ejemplares sin autor en la tabla fondos_autores
'(Ejemplares con autor declarado en fondos pero sin autor en fondos_autores)
' Creo que esa es la causa de que "Réquiem por un campesino español" de 
' Ramón J. Sender no aparezca en Abies, a pesar de que aparece en la tabla
' "ejemplares" y en la tabla "fondos".

Sub buscaEjemplaresSinAutor()
Dim Fondos As Recordset
Dim FondosAutor As Recordset
Dim xlApp As Excel.Application
Dim Book As New Excel.Workbook
Dim MySheet As Excel.Worksheet

Dim Db As Database

Set Db = Access.CurrentDb

Set xlApp = CreateObject("Excel.Application")
Set Book = xlApp.Workbooks.Add
Set MySheet = Book.Sheets(1)
        Book.Activate
        With MySheet
            With .Range("A:D")
                .HorizontalAlignment = xlLeft
                .Font.Size = 10
                .VerticalAlignment = xlTop
                .WrapText = True
            End With
            With .Range("1:2")
            .Font.Size = 12
            .VerticalAlignment = xlTop
            .HorizontalAlignment = xlCenter
            End With
            .Cells(1, 1) = "Fondos sin autor en IDAutores"
            .Cells(2, 1) = "IDFondo"
            .Cells(2, 2) = "IDAutor"
            .Cells(2, 3) = "A"
            .Cells(2, 4) = "Titulo"
            .Cells(2, 5) = "CodigoEjemplar"
            .Cells(2, 6) = "NumRegistro"
            .Cells(2, 7) = "[Signatura]"
            .Cells(2, 8) = "FechaAlta"
            .Cells(2, 9) = "[Arreglado?]"
            
            'Colorear el encabezado
            .Range("A1:G1").Cells.Interior.Color = RGB(&HFF, &HCC, _
                  &H99)
            .Range("A1:G1").HorizontalAlignment = xlCenter
            .Range("A1:G1").Merge
            .Range("A2:G2").Cells.Interior.Color = RGB(&HC0, &HC0, _
                  &HC0)
            .Columns(1).ColumnWidth = 8
            .Columns(2).ColumnWidth = 8
            .Columns(3).ColumnWidth = 20
            .Columns(4).ColumnWidth = 20
            .Columns(5).ColumnWidth = 8
            .Columns(6).ColumnWidth = 8
            .Columns(7).ColumnWidth = 8
            .Columns(8).ColumnWidth = 8
        FilaAct = 3
        End With
    
    
  consulta = "SELECT Ejemplares.CodigoEjemplar,Autores.a, "+ _
             "Fondos.Titulo, Ejemplares.Sig1, Ejemplares.Sig2,"+ _
             "Ejemplares.Sig3, Fondos.IdFondo,Fondos.IdAutor, " + _
             "Ejemplares.FechaAlta, Ejemplares.NumRegistro " + _
             "FROM (Fondos INNER JOIN Ejemplares ON " + _
             "Fondos.IdFondo = Ejemplares.IdFondo)" + _
             "INNER JOIN Autores ON Fondos.IdAutor = " + _
             "Autores.IdAutor ORDER BY Fondos.IdFondo"
  
    Set Fondos = Db.OpenRecordset(consulta, dbOpenDynaset)
    Fondos.MoveFirst
    Do Until Fondos.EOF
        While Fondos.Fields("idfondo") = "": Fondos.MoveNext: Wend
        idfondo = Fondos.Fields("IdFondo")
        consulta2 = "SELECT * FROM [Fondos_Autores] Where "+ _
              "[IdFondo]=" & idfondo & " ORDER By IdFondo"
        Set FondosAutor = CurrentDb.OpenRecordset(consulta2, _
              dbOpenDynaset)
        cuenta = FondosAutor.RecordCount
        'If idfondo = 3294 Then Stop
       If cuenta = 0 Then
            With MySheet
                .Cells(FilaAct, 1) = Fondos.Fields("idFondo")
                .Cells(FilaAct, 2) = Fondos.Fields("idAutor")
                .Cells(FilaAct, 3) = Fondos.Fields("A")
                .Cells(FilaAct, 4) = Fondos.Fields("Titulo")
                .Cells(FilaAct, 5) = Fondos.Fields("CodigoEjemplar")
                .Cells(FilaAct, 6) = Fondos.Fields("NumRegistro")
                .Cells(FilaAct, 6) = Fondos.Fields("Sig1") + _
                    " " + Fondos.Fields("Sig2") + _
                    " " + Fondos.Fields("Sig3")
                .Cells(FilaAct, 7) = Fondos.Fields("FechaAlta")
            End With
            FilaAct = FilaAct + 1
            respuesta = MsgBox( _
                    "El libro " + vbCrLf + Chr(34) + _
                    Fondos.Fields("Titulo") + Chr(34) + vbCrLf + _
                    "(autor: " + Fondos.Fields("A") + ")" + vbCrLf + _
                    "no tiene entrada de autor en la tabla " + _
                    "Fondos_Autores." + vbCrLf + _
                    "¿Crear entrada?", _
                    vbYesNo + vbQuestion, _
                    "Arreglar Autor")
            If respuesta = vbYes Then
                'Stop
                ' Inserta una línea en la hoja de cálculo
                ' avisando del arreglo.
                MySheet.Cells(FilaAct - 1, 9) = "ARREGLADO"
                'Inserta un registro nuevo en Fondos_Autores
                FondosAutor.AddNew
                FondosAutor.Fields("idAutor") = _
                     Fondos.Fields("idAutor")
                FondosAutor.Fields("idFondo") = _
                     Fondos.Fields("idFondo")
                Rem FondosAutor.Fields("idFuncion")= Vacío
                FondosAutor.Fields("Principal") = True
                FondosAutor.Update
            End If
        
        End If
        FondosAutor.Close
        Fondos.MoveNext
        Debug.Print ".";
    Loop
    Book.Application.Visible = True
End Sub