Home‎ > ‎

Crear Back-End Usando Codigo VBA

Sencillo Ejemplo de como crear una Back-End o Base de Datos Vinculada Usando Codigo VBA
 
El Codigo
 
Option Compare Database
' Procedimiento para exportar todas las tablas de la parte delantera de un back-end
' Este código de exportar las relaciones del front-end  y recrearlas en la base de datos
' back-end.
' Tiene un límite de 100 relaciones, pero esto puede ser cambiado manualmente
' modificando el límite superior de "astr" según sea necesario.
' """""""""""""Modificado por Jefferson Jimenez""""""""""""""""
Public Sub CrearBackEnd(Ruta As String)
    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(Ruta)) = 0 Then
        Set dbBE = DBEngine(0).CreateDatabase(Ruta, dbLangGeneral)
    Else
        Set dbBE = DBEngine(0).OpenDatabase(Ruta)
    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", _
            Ruta, acTable, strTable, strTable
            DoCmd.DeleteObject acTable, strTable
            DoCmd.TransferDatabase acLink, "Microsoft Access", _
            Ruta, 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
sExit:
    On Error Resume Next
    Set rel = Nothing
    Set dbFE = Nothing
    dbBE.Close
    Set dbBE = Nothing
    Exit Sub
E_Handle:
    MsgBox Err.Description & vbCrLf & "CrearBackEnd", vbOKOnly + vbCritical, _
    "Error: " & Err.Number
    Resume sExit
End Sub
SelectionFile type iconFile nameDescriptionSizeRevisionTimeUser
ċ

Descargar
Descargue el Ejemplo  350 kb v. 3 15 sept. 2009 7:25 Jefferson Jimenez
ċ

Descargar
Descargue el Ejemplo  340 kb v. 3 15 sept. 2009 7:37 Jefferson Jimenez
Comments