Programmatically splitting a Database

Programmatically splitting a Database

If you have a database, and wish to create a split database, with all of the data in the 'back-end', and the forms and reports in the 'front end', then you would normally use the database splitter that is built into Access. If, however, for some reason you can't you could always use some code. The first procedure deals with tables that don't have relationships:

Public Sub sSplitDatabase(strFile As String)
'   Code to create a BE database, and then loop through all non-system tables in the current database,
'   and export them to the new database, and then link to them
'   Accepts:
'       strFile - the name and path of the database to split the data to
    On Error GoTo E_Handle
    Dim dbBE As Database, dbFE As Database
    Dim tdf As TableDef
    Dim strTable As String
    Dim intCount As Integer, intLoop As Integer
    Set dbFE = DBEngine(0)(0)
    If Len(Dir(strFile)) = 0 Then
        Set dbBE = DBEngine(0).CreateDatabase(strFile, dbLangGeneral)
    End If
    intCount = dbFE.TableDefs.Count - 1
    For intLoop = intCount 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
            DoCmd.DeleteObject acTable, strTable
            DoCmd.TransferDatabase acLink, "Microsoft Access", strFile, acTable, strTable, strTable
        End If
    Next intLoop
sExit:
    On Error Resume Next
    Set dbFE = Nothing
    Set dbBE = Nothing
    Exit Sub
E_Handle:
    MsgBox Err.Description & vbCrLf & "sSplitDatabase", vbOKOnly + vbCritical, "Error: " & Err.Number
    Resume sExit
End Sub

The second procedure is very similar, but is more complicated as it deals with Tables that do have Relationships:

Public Sub sSplitdbFEWithRelationships(strFile As String)
'   Procedure to export all tables from the front end to a specified back-end
'   Accepts:
'       strFile - The Name and path of the back-end database.
'   Notes:
'       This code copes with relationships in the front-end database, recreating them in the back-end.
'       It has a limit of 100 relationships, but this can be manually changed by changing the upper boundary of astr as required.
    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
            DoCmd.DeleteObject acTable, strTable
            DoCmd.TransferDatabase acLink, "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
sExit:
    On Error Resume Next
    Set rel = Nothing
    Set dbFE = Nothing
    dbBE.Close
    Set dbBE = Nothing
    Exit Sub
E_Handle:
    MsgBox Err.Description & vbCrLf & "sSplitdbFEWithRelationships", vbOKOnly + vbCritical, "Error: " & Err.Number
    Resume sExit
End Sub

Top

Last modified at 06/06/2006 15:01:41