Crear base de datos mdb temporal para tablas temporales en MS Access

En las aplicaciones que desarrollo con Access me encuentro que si utilizo el mdb actual para crear tablas temporales el tamaño de archivo crece y crece aunque las tablas se borren (hasta que se realiza un compactado), por lo que es un problema ya que se ralentiza la carga de la aplicación y su funcionamiento.

Tengo algunos formularios cuyos datos pueden proceder de varias consultas y para evitar conflictos de escritura entre varios usuarios trabajo sobre una tabla temporal, permitiendo guardar los resultados y los cambios por usuario.
También es útil utilizarlas para trabajar con matrices de datos; es más rápido y eficiente utilizar una tabla bien indexada que una matriz de datos en memoria.

Buscando que solución adoptar para crear tablas en un mdb externo me encontré con un artículo y código fuente que me resolvía la papeleta totalmente, por lo que antes que hacer la reingieniería del código utilizando la idea, como no iba a mejorarlo sustancialmente lo he utilizado haciendo pequeños cambios (cambios sobre el original con licencia CC):

Function BldTempTables() As Boolean
  '============================================================
  '  Programmer: DHookom
  '  Revision #: david.losadag - arroba - gmail.com
  ' Called From:
  '        Date: 7/5/01
  '  Parameters:
  '============================================================
    On Error GoTo BldTempTables_Err
    Dim strErrMsg As String 'For Error Handling


    'Dimensionar los objetos
    Dim dbThis As DAO.Database
    Dim dbTemp As DAO.Database
    Dim tdf As DAO.TableDef
    Dim fld As DAO.Field
    Dim ndx As DAO.Index
    Dim rsStruct As DAO.Recordset   'La tabla struct
   
    'Dimensionar las variables
    Dim strFolder As String         'El directorio de la aplicación principal
    Dim strThisDBName As String     'El nombre de este mdb
    Dim strTempDBName As String     'El nombre del mdb temporal (se creará en el mismo directorio)
    Dim strNombreTabla As String    'El nombre de la tabla
   
    Set dbThis = CurrentDb
    strThisDBName = dbThis.Name
    strFolder = Left(strThisDBName, Len(strThisDBName) - _
                Len(Dir(strThisDBName)))
    strTempDBName = strFolder & "TablasTemp.MDB"
    On Error Resume Next 'Nos evitamos tener que comprobar si existe
    Kill strTempDBName 'Borra la temporal anterior en caso de que exista
    On Error GoTo BldTempTables_Err
    'Crear la tabla vacía
    Set dbTemp = CreateDatabase(strTempDBName, dbLangGeneral)
    Set rsStruct = dbThis.OpenRecordset("Select NombreTabla, NombreCampo, " & _
            "Tipocampo, Tamaño, Indexado " & _
            "FROM EstrucTablasTemp ORDER BY NombreTabla")
    With rsStruct
        If Not .EOF Then
            .MoveFirst
            Do Until .EOF
                strNombreTabla = !NombreTabla
                Set tdf = dbTemp.CreateTableDef(strNombreTabla)
                Do Until !NombreTabla <> strNombreTabla
                    Select Case !TipoCampo
                        Case dbText
                            Set fld = tdf.CreateField(!NombreCampo, _
                                     !TipoCampo, !Tamaño)
                            fld.AllowZeroLength = True
                        Case Else
                            Set fld = tdf.CreateField(!NombreCampo, !TipoCampo)
                    End Select
                   
                    tdf.Fields.Append fld
                    tdf.Fields.Refresh
                    .MoveNext
                    If .EOF Then
                        Exit Do
                    End If
                Loop
                dbTemp.TableDefs.Append tdf
                dbTemp.TableDefs.Refresh
   
            Loop
        End If
        .Close
    End With
   
    'Crear los índices
    Set rsStruct = dbThis.OpenRecordset("Select NombreTabla, NombreCampo, " & _
            "TipoCampo, Indexado, PrimaryKey " & _
            "FROM EstrucTablasTemp " & _
            "WHERE Indexado = -1 OR PrimaryKey = -1 ORDER BY NombreTabla")
    With rsStruct
        .MoveFirst
        If Not .EOF Then
            .MoveFirst
            Do Until .EOF
                Set tdf = dbTemp.TableDefs(!NombreTabla)
                'Debug.Print tdf.Name 'Para depuración
                strNombreTabla = !NombreTabla
                Do Until !NombreTabla <> strNombreTabla
                    'Debug.Print "-" & !NombreCampo 'Para depuración
                    Set ndx = tdf.CreateIndex(!NombreCampo)
                    Set fld = ndx.CreateField(!NombreCampo, !TipoCampo)
                    ndx.Fields.Append fld
                    'Establecer el primer campo-clave.
                    If !PrimaryKey = True Then
                        ndx.Primary = True
                    End If
                    tdf.Indexes.Append ndx
                    tdf.Indexes.Refresh
                    .MoveNext
                    If .EOF Then
                        Exit Do
                    End If
                Loop
            Loop
        End If
        .Close
    End With
    Set rsStruct = dbThis.OpenRecordset("Select Distinct NombreTabla " & _
                 "From EstrucTablasTemp")
    'Relincar las tablas
    With rsStruct
        .MoveFirst
        Do Until .EOF
            On Error Resume Next
            DoCmd.DeleteObject acTable, !NombreTabla
            On Error GoTo BldTempTables_Err
            DoCmd.TransferDatabase acLink, "Microsoft Access", _
                  strTempDBName, acTable, !NombreTabla, !NombreTabla
            dbThis.TableDefs.Refresh
            .MoveNext
        Loop
        .Close
    End With
    Set rsStruct = Nothing
    Set dbThis = Nothing
    Set dbTemp = Nothing
    BldTempTables = True


BldTempTables_Exit:
    Exit Function


BldTempTables_Err:
    Select Case Err
        Case Else
            strErrMsg = strErrMsg & "Error #: " & Format$(Err.Number) & vbCrLf
            strErrMsg = strErrMsg & "Descripción del error: " & Err.Description
            MsgBox strErrMsg, vbInformation, "BldTempTables"
            BldTempTables = False
            Resume BldTempTables_Exit
    End Select
End Function

Para que funcione sólo necesita una referencia a la librería de objetos MS DAO.

También necesitamos una tabla llamada "EstrucTablasTemp" para indicar la estructura de las tablas temporales que utilizaremos en nuestra aplicación de Access, de forma que podemos agregar/modificar/eliminar tablas en cualquier momento. La estructrua de esta tabla es la siguiente:

EstrucTablasTemp

NombreTabla  Texto

NombreCampo  Texto

TipoCampo   Numerico (entero)
Tamaño  Numerico (entero)
Indexado    Si/No
PrimaryKey Si/No

Los diferentes tipos de campo es un número de 1 a 12, el campo "tamaño" sólo es necesario meter un valor en los campos que lo requieren (como Texto o Binario). Su correspondencia es la siguiente:

1. Si/No
2. Número (Byte)
3. Número (Entero)
4. Número (Entero largo)
5. Moneda
6. Número (Simple)
7. Número (Doble)
8. Fecha/Hora
9. Binario
10. Texto
11. Objeto Ole
12. Memo
    

Yo utilizo esta función tras depurar los módulos con tablas locales, defino las tablas en la tabla "EstrucTablasTemp" y llamo a la función desde el menú principal de la aplicación, cuyo código de apertura (form.open) se ejecuta sólo una vez cuando se abre.
De esta forma se borra el mdb temporal anterior y se vuelven a crear las tablas vacías al abrir la aplicación, pero permanecen con los datos mientras se esté usando y no se borren.

Para más información sobre Visual Basic en MS Access consultar la ayuda del programa o esta estupenda web:
The Access Web


Disclaimer:
En caso de que alguno de los datos transcritos en este artículo contravenga alguna de las políticas de los posibles dueños del copyright, las líneas que incumplan con la licencia serán eliminadas/cambiadas en cuanto se notifique de ello.