Crear y Recuperar tus Tablas o Datos de una BD Access Sencilla

Aveces nos preguntamos como crear un (Respaldo, Back-Up, Copia de Seguridad, etc...) de una base de datos sencilla

No se trata solo de copiar y pegar un Fichero o Archivo .mdb o .accdb

Preguntaba alguien.....

1) Lo que realmente busco es extraer toda la data de mis tablas y crear un fichero aparte .mdb o .accdb

Tambien que en el proceso de la extraccion se lleve las Relaciones.........

2) Luego de haber realizado esta operacion me la grabe con la fecha del sistema para asi saber de que dia pertenece la data o informacion

3) Y claro esta poder recupear la data o tablas desde mi base de datos en uso.....

Ok. Para todo esto tenemos que crear un modulo que realize las opciones 1 y 2

El Codigo

Option Compare Database

Public Sub CopiarTabasRelaciones(strFile As String)

' Funcion para copiar solo las tablas de la base de datos

' y sus relaciones

' strFile - es el nombre que le vas a dar a la copia. En este caso yo la llamare copia

On Error GoTo E_Handle

Dim dbFE As Database, dbBE As Database

Dim tdf As TableDef

Dim rel As Relation

Dim fld As Field

Dim astr(1 To 100, 1 To 4) As String

Dim intLoop As Integer, intRelCount As Integer, intTableCount As Integer

Dim strTable As String

Set dbFE = CurrentDb

intLoop = 1

If Len(Dir(strFile)) = 0 Then

Set dbBE = DBEngine(0).CreateDatabase(strFile, dbLangGeneral)

Else

Set dbBE = DBEngine(0).OpenDatabase(strFile)

End If

For Each rel In dbFE.Relations

For Each fld In rel.Fields

astr(intLoop, 1) = rel.Table

astr(intLoop, 2) = rel.ForeignTable

astr(intLoop, 3) = fld.Name

astr(intLoop, 4) = fld.ForeignName

intLoop = intLoop + 1

Next fld

Next rel

intRelCount = dbFE.Relations.Count - 1

For intLoop = intRelCount To 0 Step -1

'dbFE.Relations.Delete dbFE.Relations(intLoop).Name

Next intLoop

intTableCount = dbFE.TableDefs.Count - 1

For intLoop = intTableCount To 0 Step -1

strTable = dbFE.TableDefs(intLoop).Name

If Left(strTable, 4) <> "MSys" And Left(strTable, 4) <> "USys" And Len(dbFE.TableDefs(intLoop).Connect) = 0 Then

DoCmd.TransferDatabase acExport, "Microsoft Access", strFile, acTable, strTable, strTable

End If

Next intLoop

For intLoop = 1 To intRelCount + 1

Set rel = dbBE.CreateRelation(astr(intLoop, 1) & astr(intLoop, 2), astr(intLoop, 1), astr(intLoop, 2))

rel.Fields.Append rel.CreateField(astr(intLoop, 3))

rel.Fields(astr(intLoop, 3)).ForeignName = astr(intLoop, 4)

dbBE.Relations.Append rel

Next intLoop

MsgBox "Proceso Concluido con exito" & vbCrLf & _

"La copia se ha grabado en " & vbCrLf & _

CurrentProject.path & "\(Copia del " _

& Format(Date, "dd-mm-yyyy") & ") " _

& CurrentProject.Name & vbCrLf & _

"Solo hemos copiado las Tablas y Sus Relaciones, y tomado" & vbCrLf & _

"La fecha del sistema, para asi saber el dia de respaldo" & vbCrLf & _

"Y Recuperar la que necesitemos.........................", vbInformation, "Grabado"

sExit:

On Error Resume Next

Set rel = Nothing

Set dbFE = Nothing

dbBE.Close

Set dbBE = Nothing

Exit Sub

E_Handle:

MsgBox Err.Description & vbCrLf & "CopiarTabasRelaciones", vbOKOnly + vbCritical, "Error: " & Err.Number

Resume sExit

End Sub

Y Despues otro modulo que me realize la Opcion 3

El Codigo

Option Compare Database

Option Explicit

'******************* Jefferson Jimenez **************************

'****************** Cabimas, Venezuela **************************

'************************* Mayo 2009 ****************************

'****************************************************************

'Primero Elimino las Relaciones de las Tablas Actuales, _

..... Habiendo eliminado las relaciones, elimino las tablas .......

Function DltTblAct()

Dim dbFE As Database, dbBE As Database

Dim tdf As TableDef

Dim rel As Relation

Dim fld As Field

Dim astr(1 To 100, 1 To 4) As String

Dim intLoop As Integer, intRelCount As Integer, intTableCount As Integer

Dim strTable As String

Set dbFE = CurrentDb

intLoop = 1

For Each rel In dbFE.Relations

For Each fld In rel.Fields

astr(intLoop, 1) = rel.Table

astr(intLoop, 2) = rel.ForeignTable

astr(intLoop, 3) = fld.Name

astr(intLoop, 4) = fld.ForeignName

intLoop = intLoop + 1

Next fld

Next rel

intRelCount = dbFE.Relations.Count - 1

For intLoop = intRelCount To 0 Step -1

dbFE.Relations.Delete dbFE.Relations(intLoop).Name

Next intLoop

intTableCount = dbFE.TableDefs.Count - 1

For intLoop = intTableCount To 0 Step -1

strTable = dbFE.TableDefs(intLoop).Name

If Left(strTable, 4) <> "MSys" And Left(strTable, 4) <> "USys" And Len(dbFE.TableDefs(intLoop).Connect) = 0 Then

DoCmd.DeleteObject acTable, strTable

End If

Next intLoop

End Function

'Ahora Copio de la Base de Datos BackUp a la Base _

de Datos Actual todas las Tablas _

que en ella estan... Incluso con sus Relaciones

Public Function ImportDb(strPath As String) As Boolean

On Error Resume Next

Dim db, cdb As Database

Dim td As TableDef

Dim strTDef, strDocName, strRName, _

strTName, strFTName, strFName, _

strFFName As String

Dim intConst As Integer

Dim rel As Relation

Dim nrel As Relation

Dim varAtt As Variant

Dim fld As Field

Set db = DBEngine.Workspaces(0).OpenDatabase(strPath, True)

For Each td In db.TableDefs

strTDef = td.Name

If Left(strTDef, 4) <> "MSys" Then

DoCmd.TransferDatabase acImport, "Microsoft Access", strPath, acTable, _

strTDef, strTDef, False

End If

For Each rel In db.Relations

With rel

strRName = .Name

strTName = .Table

strFTName = .ForeignTable

varAtt = .Attributes

Set nrel = cdb.CreateRelation(strRName, strTName, strFTName, varAtt)

For Each fld In .Fields

strFName = fld.Name

strFFName = fld.ForeignName

nrel.Fields.Append nrel.CreateField(strFName)

nrel.Fields(strFName).ForeignName = strFFName

End With

Set fld = Nothing

Set nrel = Nothing

Set rel = Nothing

Set cdb = Nothing

Set td = Nothing

db.Close

Set db = Nothing

ImportDb = True

End Function