Saludos.
Gracias a todos por contestar. Y agradezco también todas las sugerencias.
No sé si eso de dividir la BD en dos partes se puede hacer una vez que ya está configurada, o tendría que haberlo previsto antes. Lo cierto es que ni pensé en ello.
Cada tabla es independiente de las demás; es decir, no hay elementos comunes en ninguna de ellas para establecer relaciones "uno a uno" ó "uno a varios". A no ser que puedan relacionarse a través de la ID.
Como dije anteriormente la tabla funciona bien e incluso ella sola ya realiza algunos cálculos que ya están programados (lo que me evita tener que grabar los datos a mano).
Para tener un respaldo de la BD (como ya dije también), todos los dias hago una copia de seguridad a un disco duro externo. Por si acaso...... 
Veo que JoseBP te ha sugerido exactamente lo mismo que yo.
Símplemente creas otra base de datos vacía, importas todas las tablas de la que tienes (Archivo -> Obtener datos externos -> Importar, Pulsa el botón de opciones para asegurarte de que importas también los datos y las relaciones entre tablas)
En la base de datos donde tienes los formularios, borras todas las tablas (previa copia de seguridad, of course) y, seguidamente, vuelves a 'Obtener Datos externos' -> 'Vincular tablas', seleccionas la nueva base de datos donde previamente habías importado las tablas, seleccionas todas las tablas y ¡¡ya está!!
Esto te da unas cuantas ventajas:
1. Sabido es por todos los que hemos tenido que trabajar con bases de Access la facilidad que tienen de 'escoñarse' por culpa del código VBA. Si te sucede ésto, solo perderás la aplicación, no los datos. No lo solucionas haciendo copias de seguridad porque nunca sabes si cuando has hecho la copia la bbase estaba ya 'escoñada'.
2. Facilidad para trabajar en red.
3. Facilidad futura para migrar a nuevas versiones del access sin tener que tocar para nada la base de datos.
4. Puedes utilizar el mismo programa con varias bases de datos al mismo tiempo (por ejemplo con varias estaciones, en el supuesto de que las tablas esten diseñadas para una única estación)
El único problema que te puedes encontrar es que si mueves de lugar la base de datos, la aplicación ya no los encontrará.
Para evitar eso puedes hacer una macro 'autoexec' que llame a una función que reconecte si se ha perdido el enlace:
Te dejo el código que suelo utilizar para cambiar/buscar la base de datos:
Option Compare Database
Option Explicit
'*******Verssió MultiUsuari
Global EmpDBs As String
Global DocDBs As String
'Global WKs As Workspace
'*Generals
Global NomDB As String
Global DirDB As String
Global DirDoc As String
Global DirImg As String
Global NomUsuari As String
Global CliServ As Boolean
'*******Registre
Global NumSerie As String
Global NomRegistre As String
Global NumRegistre As String
Global NoEval As Boolean
Global Ejercicio As Integer
Public Function Inicio()
End Function
'****** Empresa
Public Sub BuscaNomEmpresa()
Dim db As Database
Dim T As TableDef
Dim CC As String
Dim DD As String
Dim NN As String
Dim Estat As Integer
Dim reconecta As Boolean
On Error GoTo Error_Obri
CliServ = False
Set db = CurrentDb
On Error Resume Next
NomDB = ""
DirDB = ""
Set T = db.TableDefs("_Const")
If Err = 0 Then
CC = T.Connect
If Len(CC) > 0 Then
DD = Mid$(CC, 11)
If ExistFile(DD) Then
Estat = 0
NomDB = FileName(DD)
DirDB = PathName(DD)
Else
BuscaUltimaEmpresa
DD = DirDB + NomDB
If ExistFile(DD) Then Estat = 1 Else Estat = 2
End If
Else
Estat = -1 'Local
NomDB = FileName(CurrentDb.name)
DirDB = PathName(CurrentDb.name)
CommandBars("Menú principal").Controls("&Cambio Empresa").Visible = False
End If
Else
Estat = 2
Err.Clear
End If
On Error GoTo Error_Obri
CliServ = (Estat >= 0)
If Estat = 2 Then 'Preguntar
DD = PreguntaNomEmpresa(True)
NomDB = FileName(DD)
DirDB = PathName(DD)
End If
If Estat > 0 Then
While Not ConectaEmpresa(DD)
MsgBox "El fichero " & DD & vbCr & "No es una base de datos válida", vbCritical, "¡ERROR!"
DD = PreguntaNomEmpresa(True)
NomDB = FileName(DD)
DirDB = PathName(DD)
Wend
End If
DirImg = DirDB & "Imágenes\"
DirDoc = DirDB & "Documentos\"
CambiaPropHyper
If DatosEmpresa Then GravaUltimaEmpresa Else DoCmd.Quit
DoEvents
Exit_Obri:
Set T = Nothing
Set db = Nothing
Exit Sub
Error_Obri:
MsgBox "Error al abrir Empresa: " & DD & vbCr & Err.Description, vbCritical, "¡ERROR!"
Resume Exit_Obri
End Sub
Private Sub CambiaPropHyper()
Dim db As Database
Dim P As Property
On Error Resume Next
Set db = CurrentDb
Set P = db.Containers("Databases").Documents("Summaryinfo").Properties("Hyperlink Base")
If Len(DirDoc) = 0 Then DirDoc = PathEmpresa + "\Documentos\"
P.Value = DirDoc
Set P = Nothing
Set db = Nothing
End Sub
Public Function CambiaEmpresa()
PreguntaNomEmpresa
End Function
Public Function PreguntaNomEmpresa(Optional Forsada As Boolean) As String
Dim CC As String
On Error GoTo Err_Entrada
While Len(CC) = 0
CC = OpenAccessDB
If Len(CC) = 0 Then
If Forsada Then
If MsgBox("¿Desea salir del programa sin abrir ninguna empresa?", vbCritical + vbYesNo, "¡Atención!") = vbYes Then DoCmd.Quit
Else
PreguntaNomEmpresa = DirDB + NomDB
Exit Function
End If
Else
If Not ExistFile(CC) Then CC = ""
End If
Wend
If Not Forsada Then
If ConectaEmpresa(CC) Then
DatosEmpresa
NomDB = FileName(CC)
DirDB = PathName(CC)
GravaUltimaEmpresa
End If
End If
PreguntaNomEmpresa = CC
Err_Entrada:
If Err > 0 Then
MsgBox "Error de Programa: " & CC & vbCr & Err.Description, vbCritical, "¡ERROR!"
Err.Clear
End If
End Function
Public Function ConectaEmpresa(PathDB As String) As Boolean
Dim db As Database
Dim DBN As Database
Dim T As TableDef
Dim TNou As TableDef
Dim P As Integer
Dim Pathd As String
On Error GoTo Err_Conn
Set db = CurrentDb
Set DBN = OpenDatabase(PathDB, , True)
P = DBN.TableDefs.Count
SysCmd acSysCmdInitMeter, "Abriendo Empresa " & PathDB & "...", P
P = 1
On Error Resume Next
Set T = DBN.TableDefs("_Const")
If Err > 0 Then
Err.Clear
Exit Function
End If
On Error GoTo Err_Conn
For Each T In DBN.TableDefs
SysCmd acSysCmdUpdateMeter, P
DoEvents
If Left$(T.name, 4) <> "MSys" Then
On Error Resume Next
Set TNou = db.TableDefs(T.name)
If Err = 0 Then
If TNou.Connect <> ";DATABASE=" & PathDB Then
TNou.Connect = ";DATABASE=" & PathDB
TNou.RefreshLink
End If
Else
Err.Clear
DoCmd.TransferDatabase acLink, "Microsoft Access", PathDB, acTable, T.name, T.name
End If
On Error GoTo Err_Conn
End If
P = P + 1
Next T
DBN.Close
ConectaEmpresa = True
Exit_Conn:
SysCmd acSysCmdClearStatus
Set DBN = Nothing
Set db = Nothing
Set T = Nothing
Set TNou = Nothing
Exit Function
Err_Conn:
MsgBox "Error al abrir el archivo: " & PathDB & vbCr & Err.Description, vbCritical, "¡ERROR!"
Resume Exit_Conn
End Function
Public Sub MostraUsuari()
NomUsuari = CurrentUser
CommandBars("Menú Rápido").Controls(4).Caption = NomUsuari
End Sub
Public Function SumaChar(S As String) As String
Dim i As Integer
Dim n As Integer
For i = 1 To Len(S): n = n + Asc(Mid$(S, i, 1)): Next i
SumaChar = Chr$((n Mod 26) + 65)
End Function
Public Function CodChar(S As String, Num As Integer) As Integer
Dim i As Integer
Dim n As Integer
For i = 1 To Len(S): n = n + Asc(Mid$(S, i, 1)): Next i
CodChar = (n Mod Num)
End Function
Public Function SumaCharNum(S As String) As String
Dim i As Integer
Dim n As Integer
For i = 1 To Len(S): n = n + Asc(Mid$(S, i, 1)): Next i
SumaCharNum = Chr$((n Mod 10) + 48)
End Function
Public Function ComprovaSerie(Serie As String, NomReg As String) As String
Dim i As Integer
ComprovaSerie = ""
If Len(Serie) <> 12 Then Exit Function
If Left$(Serie, 4) <> (Left$(CNomCompanyia, 3) & "C") Then Exit Function
i = Len(NomReg)
If Mid$(Serie, 5, 4) <> SumaChar(Left$(NomReg, i - 3)) & SumaChar(Left$(NomReg, i - 2)) & SumaChar(Left$(NomReg, i - 1)) & SumaChar(Left$(NomReg, i)) Then Exit Function
If Mid$(Serie, 9, 4) <> SumaCharNum(Left$(Serie, 8)) & SumaCharNum(Left$(Serie, 9)) & SumaCharNum(Left$(Serie, 10)) & SumaCharNum(Left$(Serie, 11)) Then Exit Function
ComprovaSerie = Serie
End Function
Public Sub BuscaRegistre()
Dim RegTot As Long
Dim XX As Long
RegTot = RegOpenGeneral
XX = RegQueryValue(RegTot, "Num Registro", NumRegistre)
XX = RegQueryValue(RegTot, "Nombre Registrado", NomRegistre)
RegCloseKey RegTot
NumSerie = ComprovaSerie(NumRegistre, NomRegistre)
NoEval = NumSerie <> ""
If Not NoEval Then DoCmd.OpenForm "_Registre_", , , , , acDialog
End Sub
Public Sub BuscaUltimaEmpresa()
Dim RegTot As Long
Dim XX As Long
RegTot = RegOpenLocal
XX = RegQueryValue(RegTot, "Directorio Datos", DirDB)
XX = RegQueryValue(RegTot, "Nombre Datos", NomDB)
RegCloseKey RegTot
End Sub
Public Sub GravaUltimaEmpresa()
Dim RegTot As Long
Dim XX As Long
RegTot = RegOpenLocal
XX = RegSetValue(RegTot, "Directorio Datos", REG_SZ, DirDB)
XX = RegSetValue(RegTot, "Nombre Datos", REG_SZ, NomDB)
RegCloseKey RegTot
End Sub
Public Function Compactar()
Dim Data As String
On Error Resume Next
Data = Format(Now, "yyyy-mm-dd")
RepairDatabase DirDB & NomDB
If Err > 0 Then
MsgBox Err.Description
Err.Clear
Else
CompactDatabase DirDB & NomDB, DirDB & Data & NomDB
If Err > 0 Then
MsgBox Err.Description
Err.Clear
Else
FileCopy DirDB & Data & NomDB, DirDB & NomDB
End If
End If
End Function
Public Function PathEmpresa() As String
On Error GoTo Err_Conn
If Len(DirDB) = 0 Then
DirDB = PathName(EmpresaDB)
End If
PathEmpresa = DirDB
Exit_Conn:
Exit Function
Err_Conn:
Resume Exit_Conn
End Function
Public Function PathDoc() As String
PathDoc = PathEmpresa + "\documentos\"
End Function
Public Function EmpresaDB() As String
Dim CC As String
Dim i As Integer
On Error GoTo Err_Conn
If Len(DirDB) > 0 Then
EmpresaDB = DirDB + "\" + NomDB
Else
CC = CurrentDb.TableDefs("_Const").Connect
i = InStr(CC, "=")
If i > 0 Then EmpresaDB = Mid$(CC, i + 1)
End If
Exit_Conn:
Exit Function
Err_Conn:
Resume Exit_Conn
End Function
Obviamente este código era de un programa mío de gestión para empresas, pero te sirve igual.
12 Respuestas
7304 Vistas