RE:Programa de deteccion de errores en access
Haber si te puedo guiar un poco:
1)En la BD donde estan tus tablas (las Principales) creas un Modulo y ahi le pegas este codigo:
Option Compare Database
'*******************************************************************************
'* CopiaSegurMdbActual
'* Realiza copia de Seguridad de la Mdb desde la que se corre el codigo y,
' si así se indica mediante el parámetro bolOrigenDatos, de las mdb u archivos
' desde los que están vinculadas tablas a esta mdb
'* Argumentos: --> strCarpetaDestino: OPCIONAL. Ruta Completa de la carpeta donde se quieren colocar
' las copias. Si no se especifica se colocaran en la carpeta de la mdb actual
' --> bolOrigenDatos: OPCIONAL. Valor booleano que indica si se quieren realizar
' copias de los origenes de datos de tablas vinculadas a esta mdb.
'* uso: CopiaSegurMdbActual "C:DirectorioSeguridad", False (por ejemplo)
'* Marciano Almohalla 15/11/2007 17:29
'*******************************************************************************
Function CopiaSegurMdbActual(Optional strCarpetaDestino As String, Optional bolOrigenDatos As Boolean = False) As Boolean
Dim fso As Object, _
f As Object, _
strDestino As String, _
strNombreMdb As String, _
rs As DAO.Recordset, _
i As Integer
On Error GoTo CopiaSegurMdbActual_TratamientoErrores
Set fso = CreateObject("Scripting.FileSystemObject")
'si no se ha pasado carpeta de destino, asignamos la misma de la mdb actual
If Nz(strCarpetaDestino, "") = "" Then
strCarpetaDestino = CurrentProject.Path
Else
'comprobamos que la carpeta exista, en caso contrario la creamos
If fso.folderexists(strCarpetaDestino) = False Then
If Not CompruebaRuta(strCarpetaDestino) Then
MsgBox "No se ha podido crear la carpeta de destino", vbOKOnly + vbCritical, "ERROR"
GoTo CopiaSegurMdbActual_Salir
End If
End If
End If
'comprobamos que strCarpetaDestino termine con una
If Right(strCarpetaDestino, 1) <> "" Then
strCarpetaDestino = strCarpetaDestino & ""
End If
'construimos la ruta del archivo de destino utilizando strCarpetaDestino + Nombre de la Mdb actual + fecha de hoy + extension actual del archivo.
strDestino = strCarpetaDestino & Left(CurrentProject.Name, Len(CurrentProject.Name) - 4) & Format(Date, "ddmmyyyy") & Right(CurrentProject.Name, 4)
'asignamos a la variable f la ruta completa de la mdb actual
Set f = fso.GetFile(CurrentProject.FullName)
'Hacemos la copia de la mdb actual
fso.CopyFile f, strDestino, True
'si se ha especificado que se desea respaldar las mdb que contengan las tablas vinculadas
If bolOrigenDatos Then
'Recordeset sobre la tabla MSysObjects para localizar todas las tablas vinculadas
Set rs = CurrentDb.OpenRecordset("SELECT MSysObjects.Database FROM MSysObjects " & _
"WHERE MSysObjects.Type = 6 GROUP BY MSysObjects.Database")
If Not (rs.EOF And rs.BOF) Then 'Si el recordeset devuelve registros, es decir si hay tablas vinculadas
rs.MoveLast
rs.MoveFirst
For i = 1 To rs.RecordCount 'recorremos el recordset y vamos copiando cada mdb
strNombreMdb = Mid(rs!Database, InStrRev(rs!Database, "") + 1) 'Nombre de la Mdb desde la que vinculamos tablas
strDestino = strCarpetaDestino & Left(strNombreMdb, Len(strNombreMdb) - 4) & Format(Date, "ddmmyyyy") & Right(strNombreMdb, 4)
Set f = fso.GetFile(rs!Database)
fso.CopyFile f, strDestino, True
rs.MoveNext
Next i
End If
rs.Close
Set rs = Nothing
End If
CopiaSegurMdbActual = True
CopiaSegurMdbActual_Salir:
If Not f Is Nothing Then
Set f = Nothing
End If
If Not fso Is Nothing Then
Set fso = Nothing
End If
If Not rs Is Nothing Then
rs.Close
Set rs = Nothing
End If
On Error GoTo 0
Exit Function
CopiaSegurMdbActual_TratamientoErrores:
MsgBox "Error " & Err.Number & " en proc.: CopiaSegurMdbActual de Documento VBA: Form_CopiaSeguridadMDByLasQueContenganLasTablasVinculadas (" & Err.Description & ")"
CopiaSegurMdbActual = False
Resume CopiaSegurMdbActual_Salir
End Function
2) Crea un formulario y un boton de comando al hacer clic() esto:
If CopiaSegurMdbActual("C:BACKUP", True) Then
MsgBox "Se Realizo la Copia de Seguridad en la siguiente Direccion" & vbCrLf & _
"C:BACKUP ", vbInformation, "A V I S O . . ."
Else
MsgBox "NO se pudo realizar la copia"
End If
3) En el "Boton de Officce" de tu Access 2007 pinchas y le das a "Opcione de Access" luego "Base de Datos Actual" y activas la casilla "Compactar al Cerrar"
Espero te Siva de Algo la Explicacion, Me comentas como te fue.-